VB(A)

소방 21주기 교대근무 근무표

당근쨈 2015. 4. 4. 23:15

엑셀 대한 문화충격을 안겨줬던 초과근무 서식.

그때 받은 충격을 아직 간직하다가 내 손으로 만들어보았다.

달력을 만드는 것에 중점을 뒀고

역시 어려운 부분은 공휴일 지정 부분이었다.


연도나 월을 수정하면 달력이 바뀌며 그에 맞춰서 근무도 변한다.

음력 공휴일까지 적용하는 것에는 성공했지만

설과 추석의 경우 대체공휴일을 지정하는 것에는 일단 보류.

어린이날의 대체공휴일 적용하는 것에 일단 만족.

내근 끌려가기 전 마지막 프로젝트.

나름 거대한 프로젝트.




초과근무1.xlsm


Option Explicit


Sub worK119()
    
    Dim wsData As Worksheet
    Dim InputYear As Integer, InputMonth As Integer, Days As Integer    '연,월,일
    Dim i As Integer, j As Integer    '막 쓰는 변수
    Dim cntW As Integer '매월 1일 주기 시작 변수
    Dim intCycle As Integer '근무별 주기
    Dim arrWork As Variant  '근무형태 담을 배열
    Dim SelectedDate As Date, StartDate As Date '매월 1일, 근무설정 기준일
    Dim rngDate As Date '근무일자
    
    '처리속도 향상
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    '기존자료 삭제
    With Range("F2")
        Range(.Cells, .End(xlToRight)).Resize(.CurrentRegion.Count - 1).Clear
    End With
    
    '연,월,일 설정
    Set wsData = Sheets("Data")
    InputYear = Range("A1"'연
    InputMonth = Range("B1")    '월
    SelectedDate = DateSerial(InputYear, InputMonth, 1'매월 1일
    StartDate = DateSerial(201539)  '근무기준일
    Days = DateSerial(InputYear, InputMonth + 11- SelectedDate  '일
    i = 1   '시작일
    
    '달력 및 요일 입력
    Do While i <= Days
        rngDate = DateSerial(InputYear, InputMonth, i)  '입력 날짜 설정
        
        '요일 입력
        With Cells(35 + i)
            .Value = Format(rngDate, "aaa")
            .Font.Bold = True
        End With
    
        '일자 입력
        With Cells(25 + i)
            .Value = i
            .Font.Bold = True
            
            '주말에 빨간색 및 셀색 입히기
            If Weekday(rngDate) = 1 Or Weekday(rngDate) = 7 Then
                With .Resize(2)
                    .Font.ColorIndex = 3    '빨간색
                    .Interior.ColorIndex = 36   '노란 바탕
                End With
            End If
        End With
            
        '법정 공휴일 강조
        j = 1
        Do While wsData.Cells(j, "C"<> ""
            With wsData.Cells(j, "C")
                
                '양력 공휴일
                If .Offset(, 3= "양력" Then
                    If rngDate = DateSerial(InputYear, .Value, .Offset(, 1)) Then
                        With Cells(25 + i).Resize(2)
                            .Font.ColorIndex = 3
                            .Interior.ColorIndex = 36
                        End With
                    End If
                
                '음력 공휴일
                Else
                    If Sol2Lun(InputYear, InputMonth, i) = .Value & "." & .Offset(, 1Or _
                        Sol2Lun(year(rngDate + 1), Month(rngDate + 1), Day(rngDate + 1)) = "1.1" Then   '구정 전날은 전년도 12.31이므로 별도 설정
                        With Cells(25 + i).Resize(2)
                            .Font.ColorIndex = 3
                            .Interior.ColorIndex = 36
                        End With
                    End If
                End If
            End With
            j = j + 1
        Loop
        i = i + 1   '일수 증가
    Loop
    
    '대체공휴일 적용(검은 날때문에 달력 완성 후에 대체공휴일 적용함)
    i = 1
    Do While i <= Days
        rngDate = DateSerial(InputYear, InputMonth, i)  '입력 날짜 설정
                    
        '어린이날 대체공휴일 적용
        If rngDate = DateSerial(InputYear, 55Then
                    
            '어린이날이 주말이거나 석가탄신일일 때 다음날을 대체공휴일로 지정
            If Weekday(rngDate) = 1 Or Weekday(rngDate) = 7 Or _
                Sol2Lun(InputYear, 55= "4.8" Then
                
                '바로 다음의 비공휴일을 공휴일로 지정
                With Application.FindFormat
                    .Clear
                    .Font.ColorIndex = xlAutomatic
                End With
 
                Cells.Find(What:="", After:=Cells(25 + i), SearchFormat:=True).Activate
                            
                With ActiveCell.Resize(2)
                    .Font.ColorIndex = 3
                    .Interior.ColorIndex = 36
                End With
            End If
        End If
        i = i + 1
    Loop
    
    '개인별 근무일정 입력
    j = 4
    Do While Cells(j, "A"<> ""
    
        '근무형태별 근무주기 설정
        Select Case Cells(j, "B")
            Case "1팀""2팀""3팀"
                arrWork = Array("주""주""주""주""주""""""야""""야""""야""""당""""야""""야""""당"""'근무주기.
            Case "장"
                arrWork = Array("주""주""주""당""")
        End Select
        
        intCycle = UBound(arrWork) + 1
 
        '해당일이 주기 중 몇번째인지 찾아냄
        If SelectedDate >= StartDate Then
            cntW = (SelectedDate - StartDate) Mod intCycle
        Else
            cntW = intCycle - ((StartDate - SelectedDate) Mod intCycle)
            If cntW = intCycle Then cntW = 0
        End If
        
        '근무형태별 근무주기 시작점 지정
        Select Case Cells(j, "B")
            Case "1팀": cntW = cntW + 14
            Case "2팀": cntW = cntW + 7
            Case "3팀": cntW = cntW
            Case "장": cntW = cntW + 1
        End Select
        
        '일자별 근무 입력
        For i = 1 To Days
            If cntW > intCycle Then cntW = cntW - intCycle
            If cntW = intCycle Then cntW = 0
            Cells(j, 5 + i) = arrWork(cntW)
            cntW = cntW + 1
        
            '개인별 근무현황 유효성검사
            With Cells(j, 5 + i).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                   xlBetween, Formula1:="=Data!" & wsData.Range("H1").CurrentRegion.Address
            End With
        Next i
        
        '개인별 팀 유효성검사 입력
        With Cells(j, "B").Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="=Data!" & wsData.Range("A1").CurrentRegion.Address
        End With
        
        '근무일수 함수 입력
        With Cells(j, "C")
            .Formula = "=countif(" & Range(Cells(j, "F"), Cells(j, Columns.Count).End(xlToLeft)).Address & ", ""당"")"
            .Offset(, 1= "=countif(" & Range(Cells(j, "F"), Cells(j, Columns.Count).End(xlToLeft)).Address & ", ""주"")"
            .Offset(, 2= "=countif(" & Range(Cells(j, "F"), Cells(j, Columns.Count).End(xlToLeft)).Address & ", ""야"")"
        End With
        j = j + 1
    Loop
    
    '가운데 정렬 및 열너비 자동설정 및 행높이 27
    With Range("A1").CurrentRegion
        .HorizontalAlignment = xlCenter
        Range("A1:B1").HorizontalAlignment = xlLeft
        .EntireColumn.AutoFit
        .Columns(1).ColumnWidth = 8.82
        .Columns(2).ColumnWidth = 6.71
        .RowHeight = 27
        .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Borders.LineStyle = xlContinuous
    End With
    
    '처리속도 복구
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
 
End Sub
cs


'VB(A)' 카테고리의 다른 글

자동 빼기  (1) 2015.04.19
달력 생성 및 검색 기능  (0) 2015.04.18
근무일수 파악  (0) 2015.04.01
감독자 일자 파악  (0) 2015.03.31
폴더 선택 후 셀 크기에 맞게 이미지 불러오기  (0) 2015.03.28