Skills/Excel VBA

휴무명령 자동생성 (월 회, 일 간격 확보, 주말 1회 우선순위...)

섬그늘 2008. 11. 23. 09:22

 

 

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

1

날짜

요일

휴무

계획 연도

2009

번호

성명

코드

개수

휴무일

2

2009-01-01

5

8

-2

0

계획 월

1

1

A

8

4

6

14

21

28

 

3

2009-01-02

6

6

5

0

2

B

7

4

8

15

22

29

 

4

2009-01-03

7

4

-2

0

확인

결과

3

C

4

4

6

13

20

27

 

5

2009-01-04

1

7

-2

0

4회 여부

11

4

D

1

4

9

16

23

30

 

6

2009-01-05

2

10

9

0

A 목요일 x

0

5

E

2

4

3

11

22

29

 

7

2009-01-06

3

2

0

0

B 화요일 x

0

6

F

3

4

2

14

21

28

 

8

2009-01-07

4

-1

-1

0

담당중복

0

7

G

5

4

2

9

16

23

 

9

2009-01-08

5

1

8

0

8

H

5

4

4

12

19

26

 

10

2009-01-09

6

3

6

0

전체인원

11

9

I

6

4

1

8

15

24

 

11

2009-01-10

7

-2

-2

0

시작일

2009-01-01

10

J

7

4

5

13

20

27

 

12

2009-01-11

1

4

-2

0

휴무일

2009-01-10

11

K

8

4

5

12

19

26

 

13

2009-01-12

2

7

10

0

일 간격

6

14

2009-01-13

3

2

9

0

15

2009-01-14

4

0

5

0

16

2009-01-15

5

1

8

0

공휴일 수

공휴일 목록

코드

구분

 

 

 

17

2009-01-16

6

3

6

0

1

2009-01-01

1

학습

 

C

24fri

18

2009-01-17

7

-1

-2

0

2008-11-20

2

외국어

 

 

 

19

2009-01-18

1

-1

-2

0

2008-02-07

3

정치경제

 

 

 

20

2009-01-19

2

7

10

0

2008-02-08

4

수험서

 

B

tue

21

2009-01-20

3

2

9

0

 

5

어린이

2

 

 

22

2009-01-21

4

0

5

0

 

6

인문종교

 

 

 

23

2009-01-22

5

1

4

0

7

문예

2

A

thu

24

2009-01-23

6

3

6

0

8

잡지

2

 

 

 

E2 =IF(C2>=0,IF(D2>=0,N(VLOOKUP(C2+1,J$2:L$12,3,0)=VLOOKUP(D2+1,J$2:L$12,3,0)),0),0)
M2 =COUNTIF(C$2:D$33,J2-1)
H5 =SUMPRODUCT(N(M2:M12=4))
H6 =SUMPRODUCT(((C2:C32=J3-1)+(D2:D32=J3-1))*(B2:B32<>5))
H7 =SUMPRODUCT(((C2:C32=J4-1)+(D2:D32=J4-1))*(B2:B32<>3))
H8 =SUM(E2:E32)-(31-DAY(DATE(YEAR(H11),MONTH(H11)+1,0)))
H10 =COUNTA(K2:K13)
H11 =DATE(H1,H2,1)
G17 =SUMPRODUCT((YEAR(H17:H22)=YEAR(H11))*(MONTH(H17:H22)=MONTH(H11)))

 

위 표를 엑셀시트에 붙이고 수식 입력 (파란 색상 아래 셀은 채우기, 붉은 색상은 수동 입력)합니다. 그리고 아래 코드를 가동하면 초기 작업이 완료됩니다. 월 정기휴무가 있을 경우 일 간격은 6일 정도가 한계인 듯 합니다. (그 이상 하면 모든 이가 4회 휴무되기 어려움) 화일을 보내드렸으니 Main 시트에서 여러 변수를 바꿔가며 CTRL+F 해 보세요.

 

-------------------------(start of file)

Sub dayoff_schedule()
'
'
' Keyboard Shortcut: Ctrl+f
'

Dim EN As Integer   ' employee number
Dim HD As Double    ' holiday of the month
Dim SD As Double    ' stard day of the month
Dim FD As Double    ' final day of the month
Dim TD As Double    ' temporary day for calculation
Dim nD As Integer   ' number of the day of the month
Dim Dint As Integer ' dayoff interval of each employee
Dim N() As Double   ' dates of the month
Dim PN() As Integer ' dayoff employee of the day
Dim P() As String   ' name of the employees
Dim F() As Integer  ' part of the employees
Dim Date0 As Double ' 1st. x-day date of the month
Dim CP() As Integer ' candidate of the person
Dim CN As Integer   ' number of the candidates (available at the day)
Dim CK As Integer   ' candidate check carry
Dim WP() As Integer ' number of weekend dayoff of the employee
Dim WN As Integer   ' number of WP()
Dim WKn As Integer  ' weekday number (Sun=1)
Dim Nmod As Integer ' even or odd (odd=1)
Dim Dwk As Integer  ' working day or weekend
Dim PH() As Integer ' number of dayoff of the employee
Dim PL() As Double  ' date list of each employee
Dim Hnum As Integer ' if HD is on the month, Hnum=1
Dim Nnum As Integer ' number of national holiday of the month
Dim NH() As Double  ' list of national holiday of the month
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer


'Data Reading
EN = Cells(10, 8) - 1
SD = Cells(11, 8)
HD = Cells(12, 8)
Dint = Cells(13, 8) - 1
Nnum = Cells(17, 7)
FD = DateSerial(Format(SD, "yyyy"), Format(SD, "m") + 1, 0)
nD = FD - SD
If Format(HD, "yyyy-mm") = Format(SD, "yyyy-mm") Then Hnum = 1

'Redifine Variables
ReDim N(nD), PN(nD * 2 + 1), P(EN), F(EN), CP(EN), WP(EN), PH(EN), NH(Nnum), PL(EN, 4 - Hnum)

'Data Reading Again
For i = 0 To EN
    P(i) = Cells(2 + i, 11)
    F(i) = Cells(2 + i, 12)
Next i

If Nnum > 0 Then
    For i = 1 To Nnum
        NH(i) = Cells(16 + i, 8)
    Next i
End If

'Calendar Print
Range("A2:D33").Select
Selection.ClearContents
Selection.Interior.ColorIndex = 0
Range("N2:R12").Select
Selection.ClearContents

For i = 0 To nD
   
    N(i) = SD + i
    Cells(2 + i, 1) = Format(N(i), "yyyy-mm-dd") '.font_size = 9
    Cells(2 + i, 2) = Format(N(i), "w")

Next i

If Hnum = 1 Then
    Cells(1 + Format(HD, "d"), 1).Select
    Selection.Interior.ColorIndex = 8
End If

'Pre Treatment for A, B, C

'1. C - 2nd,4th Friday
k = 3                                   ' number of C is 4, thus 4-1=3
l = 6                                   ' Friday=6
GoSub First_Date

For i = 0 To 1
    TD = Date0 + (2 * i + 1) * 7
    l = 0
    If TD <> HD Then GoSub NH_Match
    If l = 0 Then GoSub Ship1
Next i

'2. A, B - Tuesday, Thursday
For CN = 0 To 1
   
    For i = 0 To 4: CP(i) = 0: Next i   'CP() flush
    k = CN + 1
    l = 5 - CN * 2
    GoSub First_Date
   
    i = 0                               ' number of x-day in the month
    For k = 0 To 4
        TD = Date0 + k * 7
        l = 0
        If TD <> HD Then
            GoSub NH_Match
            If l = 0 And TD <= FD Then
            CP(i) = k: i = i + 1
            End If
        End If
    Next k
   
    If i > 4 Then                       ' if x-day=Fri or Sat then needed. for Tue and Thr there can't be 5th x-day in a month
        k = Int(Rnd() * i)
        CP(k) = CP(4): i = i - 1
    End If
   
    j = i: k = CN + 1: l = 3 + CN * 2
   
    If j > 0 Then
        For i = 0 To j - 1
            TD = Date0 + CP(i) * 7
            If TD <= FD Then GoSub Ship1
        Next i
    End If
   
Next CN
       
GoTo Main

First_Date:                             '1st. x-day date of the month (Date0)
i = Format(SD, "w")
If i > l Then
    j = 1
    Else: j = 0
End If
Date0 = l - i + j * 7 + SD              ' =weekday(x-day)-WEEKDAY(G11,1)+N(WEEKDAY(G11,1)>6)*7+G11
Return

NH_Match:                               ' check whether TD is National Holiday of the month
If Hnum > 0 Then
    For j = 1 To Nnum
        If TD = NH(j) Then l = 1
    Next j
End If
Return

Ship1:                                  ' stuffing sub-routine
PN((TD - SD) * 2) = k
PL(k, i) = TD
PH(k) = PH(k) + 1
Cells(2 + TD - SD, 3) = k
Return
           
            PN(i) = CN
            PL(CN, PH(CN)) = N(j)
            PH(CN) = PH(CN) + 1
            If Dwk = 1 Then WP(CN) = WP(CN) + 1
           
Main:
For i = 0 To nD * 2 + 1
    If PN(i) > 0 Then GoTo Skip1
    j = Int(i / 2)                  ' dates
    CN = 0
   
    If i = j * 2 Then
        Nmod = 0     ' = Application.WorksheetFunction.IsEven(i) (same function)
        Else: Nmod = 1
    End If
   
    WKn = Format(N(j), "w")         ' weekday number (Sat=7)
   
    Dwk = 0                         ' weekend=1, normal day=0
    If WKn = 1 Or WKn = 7 Then
        Dwk = 1
        Else
            If Nnum > 0 Then
                For l = 1 To Nnum
                    If N(j) = NH(l) Then Dwk = 1
                Next l
            End If
    End If
   
    If N(j) = HD Or (Dwk = 1 And Nmod = 1) Then
        CN = -1: GoTo Ship2
    End If
   
    CN = 0
    For k = 0 To EN
        If i = 0 Then GoTo Temp_Store
        If (PH(k) = 5 - Hnum) Or (Dwk = 1 And WP(k) > 1) Then GoTo Skip2
        If Nmod = 1 And PN(i - 1) > -1 Then
            If F(k) = F(PN(i - 1)) Then GoTo Skip2
        End If

        If j > Dint Then
            CK = Dint + 1
            Else: CK = j                                'effect of Application.WorksheetFunction.Min(i, 8)
        End If
       
        For l = 0 To CK * 2 + Nmod - 1
            If PN(i - l - 1) = k Then GoTo Skip2
        Next l
   
        If N(j) < FD Then
            If FD - N(j) > Dint Then
                CK = Dint + 1
                Else: CK = FD - N(j)
            End If
       
            For l = 0 To CK * 2 - Nmod
                WKn = PN(i + l + 1)                     ' useless WKn at the moment used for temp variable
                If WKn > 0 And WKn < 4 And k = WKn Then GoTo Skip2
            Next l
        End If
   
Temp_Store:
        If (k <> 1 Or PH(k) < 4) And (k <> 2 Or PH(k) < 4) Then
            CP(CN) = k: CN = CN + 1
        End If
Skip2:
   
    Next k
   
Ship2:
    If CN < 1 Then
        PN(i) = CN - 1           ' blank = -2, not available = -1
        Else
            CN = CP(Int(Rnd() * CN))
            PN(i) = CN
            PL(CN, PH(CN)) = N(j)
            PH(CN) = PH(CN) + 1
            If Dwk = 1 Then WP(CN) = WP(CN) + 1
    End If
   
    Cells(2 + j, 3 + Nmod) = PN(i)
   
Skip1:

Next i

'Bubble Sort
For i = 0 To EN
    For j = 1 To PH(i) - 1
        For k = j + 1 To PH(i)
            TD = PL(i, j - 1)
            If TD > PL(i, k - 1) Then
                PL(i, j - 1) = PL(i, k - 1)
                PL(i, k - 1) = TD
            End If
        Next k
    Next j
Next i

'Employee Table Print
For i = 0 To EN
    For j = 1 To PH(i)
        Cells(2 + i, 13 + j) = Format(PL(i, j - 1), "d")
    Next j
Next i

End Sub
-----------------------------------------------(end of file)

Dayoff_program.xls
0.1MB