근무일수 파악

첫 근무일, 마지막 근무일과

연속된 근무일은 ~ 로 묶어주는 매크로

~ 로 묶어주는 건 짜둔 게 있어 그걸로 썼다.

Sub fnWork()
 
    Dim rngArea As Range
    Dim rngC As Range
    Dim i As Integer, j As Integer, k As Integer
    Dim arrNum() As Integer, ValArr() As Integer
    Dim strText() As String
    Dim cntR As Integer
    
    '작업속도 향상
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    '기존자료 삭제
    Range("C4", Cells(Rows.Count, "C").End(xlDown)).Resize(, 3).ClearContents
    
    cntR = 4
    '번호열에 값이 있을 때까지 반복 작업
    Do While Cells(cntR, "A") <> ""
    
        '근무영역 지정
        Set rngArea = Range(Cells(cntR, "F"), Cells(cntR, Columns.Count).End(xlToLeft)).SpecialCells(2)
    
        '날짜 순환하며 근무일자를 배열에 넣음
        For Each rngC In rngArea.Offset(-cntR + 2)
            ReDim Preserve arrNum(i)
            arrNum(i) = rngC
            i = i + 1
        Next rngC
    
        For i = 0 To UBound(arrNum)
          On Error Resume Next
                
                '연속된 숫자일 때 재배열
                If arrNum(i + 1) = arrNum(i) + 1 Then
                    If Err.Number = 0 Then
                        ReDim Preserve ValArr(j)
                        ValArr(j) = arrNum(i)
                        j = j + 1
                        
                    '배열의 끝일 때
                    Else
                        ReDim Preserve ValArr(j)
                        ValArr(j) = arrNum(i)
                        ReDim Preserve strText(k)
                        
                        '앞뒤로 연속된 숫자가 아닐 땐 ~ 안 붙임
                        If IsEmpty(ValArr(1)) Then
                            strText(k) = ValArr(0)
                        Else
                            strText(k) = ValArr(0) & "~" & ValArr(j)
                        End If
                        k = 0
                        j = 0
                    End If
                    On Error GoTo 0
                
                '연속되지 않은 숫자일 때 ~ 로 묶음
                Else
                    ReDim Preserve ValArr(j)
                    ValArr(j) = arrNum(i)
                    ReDim Preserve strText(k)
                        
                    '앞뒤로 연속된 숫자가 아닐 땐 ~ 안 붙임
                    If IsEmpty(ValArr(1)) Then
                        strText(k) = ValArr(0)
                    Else
                        strText(k) = ValArr(0) & "~" & ValArr(j)
                    End If
                    k = k + 1
                    j = 0
                End If
        Next i
        
        '값 입력
        With Cells(cntR, "C")
            .Value = rngArea.Columns(1).Offset(-cntR + 2) '첫근무 일자
            .Offset(, 1) = Cells(cntR, Columns.Count).End(xlToLeft).Offset(-cntR + 2) '마지막근무일자
            .Offset(, 2) = Join(strText, ",") '근무일자
        End With
    
    i = 0
    ReDim arrNum(i)
    ReDim ValArr(j)
    ReDim strText(k)
    
    cntR = cntR + 1
    Loop
    
    '작업속도 복구
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

엑셀함수연습.xlsm