基于VBA实现Sheet1与Sheet2跨列匹配对比及差异标注需求

Hey there! Since you're new to VBA, I've put together a detailed, commented code that checks all your boxes. Let me walk you through what it does and how to get started:

Key Features #

• Uses a specified primary key column from Sheet1 to match rows in Sheet2
• Highlights mismatched cells in Sheet2 with a light red fill
• Creates a clear difference log in Sheet3, including:
  • Primary key value
  • Column name where the mismatch occurred
  • Value from Sheet1
  • Value from Sheet2
• Handles large datasets efficiently (up to 10,000 rows) using arrays—way faster than looping through cells directly!

Step-by-Step Setup #

1. Open your Excel workbook
2. Press Alt + F11 to open the VBA Editor
3. Right-click your workbook in the Project Explorer > Insert > Module
4. Paste the code below into the module
5. Adjust the configuration variables at the top to match your workbook (like which column is your primary key)

Full VBA Code #

Sub CompareSheetsAndLogDifferences()
    ' --------------------------
    ' CONFIGURATION - EDIT THESE!
    ' --------------------------
    Const primaryKeyCol As String = "A" ' Column in Sheet1 with your primary key (e.g., "A" for Column A)
    Const sheet1Name As String = "Sheet1"
    Const sheet2Name As String = "Sheet2"
    Const sheet3Name As String = "Sheet3"
    Const highlightColor As Long = RGB(255, 204, 204) ' Light red for mismatches in Sheet2
    
    ' --------------------------
    ' DECLARE VARIABLES
    ' --------------------------
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim data1 As Variant, data2 As Variant
    Dim keyDict As Object ' Dictionary to map primary keys to Sheet1 row data
    Dim lastRow1 As Long, lastRow2 As Long, lastCol1 As Long, lastCol2 As Long
    Dim i As Long, j As Long, k As Long
    Dim key1 As String, key2 As String
    Dim colName1 As String
    Dim logRow As Long
    
    ' Set references to worksheets
    Set ws1 = ThisWorkbook.Sheets(sheet1Name)
    Set ws2 = ThisWorkbook.Sheets(sheet2Name)
    Set ws3 = ThisWorkbook.Sheets(sheet3Name)
    
    ' Clear previous highlights in Sheet2
    ws2.Cells.Interior.ColorIndex = xlNone
    
    ' Clear previous log in Sheet3
    ws3.Cells.Clear
    ' Add log headers
    ws3.Range("A1:D1").Value = Array("Primary Key", "Column Name", "Sheet1 Value", "Sheet2 Value")
    ws3.Range("A1:D1").Font.Bold = True
    logRow = 2 ' Start logging from row 2
    
    ' Load Sheet1 data into array for fast processing
    lastRow1 = ws1.Cells(ws1.Rows.Count, primaryKeyCol).End(xlUp).Row
    lastCol1 = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
    data1 = ws1.Range(ws1.Cells(1, 1), ws1.Cells(lastRow1, lastCol1)).Value
    
    ' Load Sheet2 data into array
    lastRow2 = ws2.Cells(ws2.Rows.Count, ws2.Cells(1, ws2.Columns.Count).End(xlToLeft).Column).End(xlUp).Row
    lastCol2 = ws2.Cells(1, ws2.Columns.Count).End(xlToLeft).Column
    data2 = ws2.Range(ws2.Cells(1, 1), ws2.Cells(lastRow2, lastCol2)).Value
    
    ' Create dictionary to map Sheet1 primary keys to their row data
    Set keyDict = CreateObject("Scripting.Dictionary")
    keyDict.CompareMode = vbTextCompare ' Case-insensitive matching
    
    ' Populate dictionary with Sheet1 data
    For i = 2 To lastRow1 ' Skip header row (row 1)
        key1 = Trim(CStr(data1(i, ws1.Columns(primaryKeyCol).Column)))
        If key1 <> "" And Not keyDict.Exists(key1) Then
            keyDict.Add key1, i ' Store the row number in Sheet1 for this key
        End If
    Next i
    
    ' Loop through each row in Sheet2 to find matches and compare data
    For i = 2 To lastRow2 ' Skip header row (row 1)
        ' Find primary key column in Sheet2 header
        Dim pkCol2 As Long
        On Error Resume Next
        pkCol2 = ws2.Rows(1).Find(primaryKeyCol, LookIn:=xlValues, LookAt:=xlWhole).Column
        On Error GoTo 0
        
        If pkCol2 > 0 Then
            key2 = Trim(CStr(data2(i, pkCol2)))
            ' Check if key exists in Sheet1
            If keyDict.Exists(key2) Then
                ' Get the matching row number in Sheet1
                j = keyDict(key2)
                
                ' Compare each column in Sheet1 to find matches in Sheet2
                For k = 1 To lastCol1
                    colName1 = data1(1, k)
                    ' Find this column name in Sheet2 header
                    Dim colIndex2 As Long
                    On Error Resume Next
                    colIndex2 = ws2.Rows(1).Find(colName1, LookIn:=xlValues, LookAt:=xlWhole).Column
                    On Error GoTo 0
                    
                    ' If column exists in Sheet2, compare values
                    If colIndex2 > 0 Then
                        If CStr(data1(j, k)) <> CStr(data2(i, colIndex2)) Then
                            ' Highlight mismatch in Sheet2
                            ws2.Cells(i, colIndex2).Interior.Color = highlightColor
                            
                            ' Log the difference in Sheet3
                            ws3.Cells(logRow, 1).Value = key2
                            ws3.Cells(logRow, 2).Value = colName1
                            ws3.Cells(logRow, 3).Value = data1(j, k)
                            ws3.Cells(logRow, 4).Value = data2(i, colIndex2)
                            logRow = logRow + 1
                        End If
                    End If
                Next k
            Else
                ' Optional: Log keys in Sheet2 that don't exist in Sheet1
                ws3.Cells(logRow, 1).Value = key2
                ws3.Cells(logRow, 2).Value = "Primary Key Not Found in Sheet1"
                logRow = logRow + 1
            End If
        End If
    Next i
    
    ' Auto-fit columns in Sheet3 for readability
    ws3.Columns("A:D").AutoFit
    
    ' Inform user when done
    MsgBox "Comparison complete! Differences logged in " & sheet3Name & ".", vbInformation
End Sub

How to Use the Code #

1. Adjust Configuration Variables: At the top of the code, change primaryKeyCol to match your primary key column (e.g., "B" if it's Column B in Sheet1). You can also tweak sheet names or the highlight color if needed.
2. Run the Macro: Go back to Excel, press Alt + F8, select CompareSheetsAndLogDifferences, and click "Run".
3. Review Results:
   • Sheet2 will have light red cells where values don't match Sheet1 (only for columns present in both sheets)
   • Sheet3 will have a clear log of every mismatch, plus notes for any primary keys in Sheet2 that aren't in Sheet1

Notes for Beginners #

• Ensure your primary key values are unique in Sheet1 (the dictionary will only store the first occurrence if duplicates exist)
• The code assumes headers are in row 1 of all sheets—adjust the row numbers in the loops if your headers are elsewhere
• If you get an error about the dictionary, go to Tools > References in the VBA Editor and check "Microsoft Scripting Runtime" (though late binding should make this unnecessary)

内容的提问来源于stack exchange，提问作者manoj