엑셀 VBA 두개의 시트를 비교하여, 그 결과를 새로운 파일을 생성하여 기록해주는 매크로 함수(비주얼 베이직, 매크로, 시트 비교)

Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
Dim r As Long, c As Integer
Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
Dim rptWB As Workbook, DiffCount As Long
    Application.ScreenUpdating = False
    Application.StatusBar = "리포트 생성..."
    Set rptWB = Workbooks.Add
    Application.DisplayAlerts = False
    While Worksheets.Count > 1
        Worksheets(2).Delete
    Wend
    Application.DisplayAlerts = True
    With ws1.UsedRange
        lr1 = .Rows.Count
        lc1 = .Columns.Count
    End With
    With ws2.UsedRange
        lr2 = .Rows.Count
        lc2 = .Columns.Count
    End With
    maxR = lr1
    maxC = lc1
    If maxR < lr2 Then maxR = lr2
    If maxC < lc2 Then maxC = lc2
    DiffCount = 0
    For c = 1 To maxC
        Application.StatusBar = "Comparing cells " & Format(c / maxC, "0 %") & "..."
        For r = 1 To maxR
            cf1 = ""
            cf2 = ""
            On Error Resume Next
            cf1 = ws1.Cells(r, c).FormulaLocal
            cf2 = ws2.Cells(r, c).FormulaLocal
            On Error GoTo 0
            If cf1 <> cf2 Then
                DiffCount = DiffCount + 1
                Cells(r, c).Formula = "'" & cf1 & " <> " & cf2
            End If
        Next r
    Next c
    Application.StatusBar = "리포트 포맷 중..."
    With Range(Cells(1, 1), Cells(maxR, maxC))
        .Interior.ColorIndex = 19
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        On Error Resume Next
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        On Error GoTo 0
    End With
    Columns("A:IV").ColumnWidth = 20
    rptWB.Saved = True
    If DiffCount = 0 Then
        rptWB.Close False
    End If
    Set rptWB = Nothing
    Application.StatusBar = False
    Application.ScreenUpdating = True
    MsgBox DiffCount & " 셀에 다른 값이 있습니다!", vbInformation, _
        "비교 :" & ws1.Name & " 와 " & ws2.Name
End Sub

엑셀 파일에서 두 시트를 비교하여, 그 결과를 새로운 파일을 생성하여 기록해주는 아주 유용한 매크로 함수입니다.

두 자료의 내용을 비교해서 다른 부분을 확인 해야 할 때, 특히 긴 문장으로 이루어진 자료를 비교해서 수정 / 변경 해야 할 때 정말 좋아요!

​매크로는 함수 실행을 위한 checkCompareWorksheets() 와 CompareWorksheets() 두개로 나뉘어져 있습니다. [ 파일은 아래 '예제파일 다운로드'를 참조해주세요. ]

​[ 사용법 ]

비교 하고 싶은 두개의 시트명을 아래 checkCompareWorksheets() 함수에 차례로 입력 해주고, '시트 비교 하기' 버튼을 눌러 매크로를 실행 해주면, 새로운 엑셀 파일이 열려, 같은 행, 열에 두 시트의 다른 부분을 기록해줍니다.

Sub checkCompareWorksheets()
    '두 시트 비교
    CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")
End Sub

▼ 예제파일 다운로드 ▼

두시트비교하기.xlsm

0.02MB

아래는 알트(Alt) + F11키를 누르면 나타나는 비주얼 베이직과 매크로 메뉴를 기본 메뉴에 보이게 설정하는 방법과 매크로 실행 버튼은 만드는 법에 대한 설명입니다.

​▼ 매크로 실행 버튼 만드는 법 ▼

'Sheet1'의 자료는 전국에 있는 공공기관 들의 주소록 일부를 발췌 한 것인데요, 예제로 사용하기 위해서, 조금 변경한 내용을 'Sheet2'에 옮겨 두었습니다.

'Sheet2'의 자료입니다. 눈으로 봐서는 차이점을 알기가 어렵습니다.

​시트 비교하기 버튼을 눌러 새로운 통합문서.xls의 'Sheet1'에 비교한 결과가 입력됩니다.

[ 매크로 저장 ]

1. 알트(Alt) + F11키를 눌러 비주얼 베이직 창을 열고, 현재_통합문서에서 마우스 우측 버튼을 눌러 삽입 > 모듈을 클릭 하여 추가해줍니다.

​2. 아래 매크로를 복사/붙여넣기 한 후 알트(Alt) + Q를 눌러 워크시트 화면으로 돌아 온 다음 자료를 입력 해줍니다.