주간(A)-야간(B) 피로도 지수로 교대근무표 짜기

 

 

 

구분	1	2	3	4	5	6	7	8	9
	월	화	수	목	금	토	일	월	화
갑	X	A	B	C	X	-	-	B	C
을	B	C	X	A	B	C	-	A	B
병	C	X	A	B	C	-	B	C	X
정	A	B	C	X	A	B	C	X	A

 

근무구분 A:주간, B:야간, C:비번, X:대휴, -:주휴

 

근무 원칙

1. ABCX -->BCXA (평일)

2. 토일공휴일에는 직전 A는 B, 직전 B는 C, 나머지는 -(주휴)

3. 직전 A가 없는 경우 직전 B를 C로 놓은 후 피로도가 적은 이를 B로 둠.

 

코드 예

 

Sub 사무실()
'
' 사무실 Macro
' 근무편성 프로그램
'
' Keyboard Shortcut: Ctrl+b
'
Dim EN As Integer   ' number of employee
Dim YR As Long      ' year
Dim MH As Integer   ' month
Dim SD As Integer   ' stard day of the program
Dim FD As Integer   ' final day of the month
Dim SP As Integer   ' number of shift pattern
Dim ER() As Integer   ' employee order (along with tired point)
Dim DC() As Integer ' date code of each day of the month ; 0(nor), 1(sat), 2(sun), 3(hol)
Dim TI() As Integer ' tired index of each shift pattern
Dim TP() As Integer ' tired point of employee
Dim WC() As Integer ' working code of employee at the day
Dim WS() As String  ' symbol of shift pattern ; 01234=ABCX-
Dim PI() As Integer ' priority index of the day
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim n As Integer

'screen clear
Range("c6:ag16").Select
Selection.ClearContents
Selection.Interior.ColorIndex = 0

'color index
'For i = 0 To 20
'    Cells(24, 16 + i) = i
'    Cells(25, 16 + i).Select
'    Selection.Interior.ColorIndex = i
'Next i

'Data Reading
EN = 3
SP = 4
YR = Cells(24, 2)
MH = Cells(25, 2)
SD = Cells(27, 3)
FD = Format(DateSerial(YR, MH + 1, 0), "dd")

'Redifine Variables
ReDim ER(EN), DC(FD - SD), TI(SP), WS(SP), TP(EN), WC(FD - SD, EN), PI(EN)

'Reading Again and initialization
For i = 0 To EN
    ER(i) = i
    TP(i) = Cells(25 + i, 10)                   'initial tired point of employee
Next i

For i = 0 To SP
    WS(i) = Cells(28, 3 + i)
    TI(i) = Cells(29, 3 + i)                    'tired index of each shift pattern
Next i

For i = 0 To 4
    j = Cells(26, 3 + i)
    If j >= SD Then
        DC(j - SD) = 3                          'marking as holiday
        Range(Cells(6, j + 2), Cells(16, j + 2)).Select
        Selection.Interior.ColorIndex = 7
    End If
Next i

For i = SD To FD
    Cells(6, i + 2) = i
    Cells(7, i + 2) = Format(DateSerial(YR, MH, i), "aaa")
    If DC(i - SD) = 0 Then
        j = Format(DateSerial(YR, MH, i), "w")  'weeknumber ; 1=Sun, 7=Sat
            If j = 1 Or j = 7 Then
                j = 2 - j / 7                   'Sat=1, Sun=2, Nor=0
                DC(i - SD) = j
                Range(Cells(6, i + 2), Cells(16, i + 2)).Select
                If j = 1 Then Selection.Interior.ColorIndex = 4     'Sat color
                If j = 2 Then Selection.Interior.ColorIndex = 8     'Sun color
            End If
    End If

Next i

'program MAIN

For i = 0 To FD - SD

    For j = 0 To EN - 1
        For k = j + 1 To EN
            If TP(ER(j)) > TP(ER(k)) Or (TP(ER(j)) = TP(ER(k)) And Rnd() > 0.5) Then
                l = ER(j)
                ER(j) = ER(k)   'employee order swap along to tireness
                ER(k) = l       'if same score, random swap
            End If
        Next k
    Next j
   
    l = 1
    If DC(i) > 0 Then l = 0
   
    If i = 0 Then                               'first day
        For j = 0 To EN
            k = 0
            If j > 0 Then k = 1
            k = j * l + k * (4 - 4 * l)         'nor:0123, hol:0444
            WC(i, ER(j)) = k                    'mark the strongest as B
        Next j
    End If

    If i > 0 Then
        For j = 0 To EN                         'to prevent error...
            If WC(i - 1, j) = 0 Then k = j      'person who is B at the previous day
            If WC(i - 1, j) = 1 Then m = j      '              A
        Next j
        For j = 0 To EN
            If ER(j) = k Then n = j
        Next j
        j = ER(EN): ER(EN) = ER(n): ER(n) = j   'change his priority with the lowest
        WC(i, k) = 3                            'put his work code as C(=3) at the day
       
        k = 0
        If DC(i - 1) = 0 Then k = 1             'if previous day is normal
       
        If k = 1 Then WC(i, m) = 0              'previous A should be B at the day
       
        If l * k = 1 Then                       'if normal-normal day
            For j = 0 To EN
                m = WC(i - 1, j)
                If m > 1 Then
                    WC(i, j) = m - 1            'BAXC-->CBAX (0123-->3012)
                End If
            Next j
        End If
   
        If k = 1 And l = 0 Then                 'if normal-holiday
            For j = 0 To EN                     'BAXC-->CB-- (0123-->3044)
                If WC(i - 1, j) > 1 Then WC(i, j) = 4
            Next j
        End If
       
        If k = 0 And l = 1 Then                 'if hol-normal day
            For j = 0 To EN - 1                 'BAX due to tired ranking
                WC(i, ER(j)) = j
            Next j
        End If
       
        If k + l = 0 Then                       'if hol-holiday
            For j = 0 To EN - 1                 'B-- due to tired ranking
                If j = 0 Then m = 0
                If j > 0 Then m = 4
                WC(i, ER(j)) = m
            Next j
        End If
       
    End If
   
    For j = 0 To EN
        TP(j) = TP(j) + TI(WC(i, j))
'        Cells(10 + 2 * j, 3 + i) = TP(j)        '피로도 출력(option)
    Next j

'Cells(5, 3 + i) = 2 * k + l                    'to verify date code

Next i

'printing

For j = 0 To EN
    For i = 0 To FD - SD
        Cells(9 + 2 * j, SD + i + 2) = WS(WC(i, j))
    Next i
    Cells(25 + j, 11) = TP(j)                   'tired point at the end
Next j

End Sub