[VBA] 날짜 중복 검출하기(DATE OVERLAP)

회사에서 직원별 휴가 시작일과 종료일을 관리하는 엑셀을 작성했다고 가정합니다.

원본 데이터를 하나의 워크시트에 취합했는데 겹치는 날짜가 있는데 찾기가 어렵습니다.

VBA를 활용하여 간단하게 중복되는 날짜를 검출해 보겠습니다.

1. 예제 데이터 시트

아래의 예제 데이터 시트를 보면 소속사, 성명, 시작일, 종료일이 있습니다.

같은 배경색의 행끼리 날짜가 중복되고 있음을 확인할 수 있습니다.

이런 행이 수천 행이 존재한다면? 눈으로 검증할 생각을 하면 생각만 해도 퇴사 마렵습니다.

2. VBA 매크로 파일 만들기

아래의 그림과 같이 매크로 파일을 하나 만들어 줍니다. 매크로 파일을 만드는 자세한 방법은 이전 포스팅을 참조하세요.

2023.12.01 - [프로그래밍/Excel VBA] - [VBA] 엑셀 VBA 사용법

파라미터를 4개 입력받도록 하였습니다.

Target File Path: 검증할 엑셀 파일이 존재하는 파일 경로를 입력합니다.
Target File Name: 검증할 엑셀 파일명을 입력합니다.
Target Worksheet: 검증할 엑셀 파일명 내의 워크시트명을 입력합니다.
Data Entry Row No: 데이터가 시작하는 행 번호를 입력합니다.

Summary Report에는 날짜 중복이 검출되었는지, 몇 개 검출되었는지 알려줍니다.

3. 날짜 중복 여부 검출 알고리즘

예제 데이터 시트의 5행과 7행은 날짜가 겹치는 상황입니다. 5행을 원본데이터, 7행을 비교데이터라고 할 때 슈도코드는 아래와 같습니다. 원본데이터와 비교데이터가 서로 바뀌어도 상관없습니다.

' DATE OVERLAP 검출 슈도 코드
If 원본시작날짜 <= 비교종료날짜 And 비교시작날짜 <= 원본종료날짜 Then
	날짜겹칩(DATE OVERLAP) 발생!!
 End If

4. 실행결과 확인

아래 실행 결과를 예제 데이터와 비교해 보면 중복이 발생한 행 정보를 Row index에 표기해 주고 있음을 확인할 수 있습니다.

5. 검증매크로 소스코드

매크로파일의 소스코드 전체를 공개합니다. [START] Data Validation이 날짜 중복 여부 검출 부분입니다.

Public Function FileExists(ByVal path_ As String) As Boolean
    FileExists = (Dir(path_, vbDirectory) <> "")
End Function

Sub VacationDupCheck_Click()

    Dim shtThisVBA As Worksheet
    Set shtThisVBA = ThisWorkbook.Worksheets("vba")
    
    ' Define User-friendly Color Index variables
    Const COLORINDEX_WHITE As Integer = 0
    Const COLORINDEX_RED As Integer = 3
    Const COLORINDEX_GREEN As Integer = 4
    Const COLORINDEX_BLUE As Integer = 5
    Const COLORINDEX_YELLOW As Integer = 6
    Const COLORINDEX_PINK As Integer = 7
    Const COLORINDEX_ORANGE As Integer = 46
    
    
    ' Declare a string variable to store the path of the file to be validated
    Dim strTargetFilePath As String
    Dim strTargetFileName As String
    Dim strTargetWorksheetName As String
    Dim lEntryRowNo As Long
    Dim lLastRowNo As Long
    strTargetFilePath = shtThisVBA.Range("E4").Value
    strTargetFileName = shtThisVBA.Range("E5").Value
    strTargetWorksheetName = shtThisVBA.Range("E6").Value
    lEntryRowNo = shtThisVBA.Range("E7").Value
    
    
    ' Concatenate the file path and filename to complete the full path.
    Dim strTargetFullPath As String
    strTargetFullPath = strTargetFilePath + "\" + strTargetFileName
    
    Debug.Print "[INFO] strTargetFilePath: " & strTargetFilePath
    Debug.Print "[INFO] strTargetFileName: " & strTargetFileName
    Debug.Print "[INFO] strTargetWorksheetName: " & strTargetWorksheetName
    Debug.Print "[INFO] strTargetFullPath: " & strTargetFullPath
    Debug.Print "[INFO] lEntryRowNo: " & lEntryRowNo
    
    ' [START] Verify the existence of the target file. and target worksheet
    Dim wbTargetWorkBook As Workbook
    Dim wsTargetWorksheet As Worksheet
    
    If FileExists(strTargetFullPath) Then
        Set wbTargetWorkBook = Workbooks.Open(strTargetFullPath)
    Else
        MsgBox "[ERROR] No Such Target File Path" & vbNewLine & _
                strTargetFullPath, vbCritical
        Exit Sub
    End If
    
    ' Verify the existence of the target worksheet.
    Dim boVerified As Boolean
    boVerified = False
    For Each wsTargetWorksheet In wbTargetWorkBook.Worksheets
        If wsTargetWorksheet.Name = strTargetWorksheetName Then
            boVerified = True
            Exit For
        End If
    Next wsTargetWorksheet
    
    If boVerified Then
        Debug.Print "[INFO] Worksheet Lookup Success: " & strTargetWorksheetName
    Else
        MsgBox "[ERROR] No Such Target Worksheet Name" & vbNewLine & _
                strTargetWorksheetName, vbCritical
        Exit Sub
    End If
    ' [END] Verify the existence of the target file. and target worksheet

    lLastRowNo = wsTargetWorksheet.Cells(wsTargetWorksheet.Rows.Count, 1).End(xlUp).Row
    Debug.Print "[INFO] lLastRowNo: " & lLastRowNo
    
    Dim i As Long
    Dim j As Long
    Dim sDateRoot As Date
    Dim eDateRoot As Date
    Dim strIdNameRoot As String
    Dim sDateCmp As Date
    Dim eDateCmp As Date
    Dim strIdNameCmp As String
    Dim lCntError As Long
    Dim lReportIndex As Long: lReportIndex = 16
    
    Dim strTimeStampStart As String
    strTimeStampStart = Format(Now, "yyyy-MM-dd hh:mm:ss")
    Debug.Print "[INFO] strTimeStampStart: " & strTimeStampStart

    lCntError = 0
    ' [START] Data validation
    For i = lEntryRowNo To lLastRowNo - 1
        strIdNameRoot = wsTargetWorksheet.Cells(i, 3).Value
        strIdNameRoot = strIdNameRoot + "-" + wsTargetWorksheet.Cells(i, 4).Value
        sDateRoot = wsTargetWorksheet.Cells(i, 5).Value
        eDateRoot = wsTargetWorksheet.Cells(i, 7).Value
        ' Debug.Print "[INFO] strIdNameRoot: " & strIdNameRoot
        
        For j = i + 1 To lLastRowNo
            strIdNameCmp = wsTargetWorksheet.Cells(j, 3).Value
            strIdNameCmp = strIdNameCmp + "-" + wsTargetWorksheet.Cells(j, 4).Value
            sDateCmp = wsTargetWorksheet.Cells(j, 5).Value
            eDateCmp = wsTargetWorksheet.Cells(j, 7).Value
            
            If sDateRoot <= eDateCmp And sDateCmp <= eDateRoot Then
                lCntError = lCntError + 1
                shtThisVBA.Cells(lReportIndex, "D") = "Date Overlap"
                shtThisVBA.Cells(lReportIndex, "E") = strIdNameRoot
                shtThisVBA.Cells(lReportIndex, "F") = i & ", " & j
                lReportIndex = lReportIndex + 1
                Debug.Print "[HIT] strIdNameRoot: " & strIdNameRoot & ": overlap " & i & " with "; j
            End If
            
        Next
        
    Next
    ' [END] Data validation
    
    ' Write Summary Report
   
    shtThisVBA.Cells(11, "E") = strTimeStampStart
    shtThisVBA.Cells(12, "E") = lCntError
    If lCntError Then
        shtThisVBA.Cells(12, "E").Interior.ColorIndex = COLORINDEX_RED
    Else
        shtThisVBA.Cells(12, "E").Interior.ColorIndex = COLORINDEX_GREEN
    End If
    
End Sub

이상으로 엑셀 VBA 매크로를 활용하여 날짜(DATE) 속성 데이터의 시작일, 종료일 간 중복 여부를 검출하는 코드를 작성해 보았습니다.

저작자표시 비영리 변경금지

'프로그래밍 > Excel VBA' 카테고리의 다른 글

[VBA] 엑셀 VBA 사용법 (0)	2023.12.01