使用VBA复制粘贴脚本对比两个CSV文档的性能优化求助

Hey there, I feel your pain—spending a week stuck on this and then settling for a half-day manual workaround is brutal. Let’s get you set up with way more efficient solutions since you already have both CSV tables loaded into your local workbook. All these methods will cut your processing time down to minutes (or even seconds) instead of hours.

1. Quick Visual Comparison with XLOOKUP + Conditional Formatting #

This is great if you want a simple, no-code way to spot differences right in your existing sheets:

• Assume your two tables are in Sheet1 and Sheet2
• In Sheet1, add a new column E (label it Subject1_Sheet2) and paste this formula, then drag it down to cover all 6000 rows:

  =XLOOKUP(A1, Sheet2!A:A, Sheet2!B:B, "Not found in Sheet2")
  

• Repeat this for columns F (Subject2_Sheet2) and G (Artefact_Sheet2) using Sheet2!C:C and Sheet2!D:D respectively
• Now select columns E-G, go to Home > Conditional Formatting > New Rule > Use a formula to determine which cells to format
• For column E, use this formula to highlight mismatches:

  =E1<>B1
  

  Set a fill color (like light red) to make differences pop instantly. Do the same for F vs C, G vs D.

2. Automated Merge & Compare with Power Query #

Power Query is perfect for bulk data comparison and generates a clean, organized report:

1. Go to Data > Get Data > From Table/Range for both Sheet1 and Sheet2 to load them into the Power Query Editor
2. In the editor, go to Home > Merge Queries > Merge as New Query
   • Select Sheet1 as the left table, Sheet2 as the right table
   • Choose column A as the join key, and pick Full Outer Join (this will show all entries from both tables)
3. Expand the merged Sheet2 columns, rename them to something like Subject1_Sheet2, Subject2_Sheet2, Artefact_Sheet2
4. Add custom columns to flag differences:
   • For Subject1: =if [Subject1] <> [Subject1_Sheet2] then "Mismatch" else "Match"
   • Repeat for the other two columns
5. Click Close & Load To to export the comparison results to a new worksheet. Done in 5 minutes tops.

3. One-Click Comparison with VBA Macro #

If you need to do this regularly, a VBA script will automate the entire process in seconds:
Open the VBA editor with Alt+F11, insert a new module, and paste this code (update the sheet names if yours are different):

Sub CompareDocumentTables()
    Dim wsSource As Worksheet, wsTarget As Worksheet, wsReport As Worksheet
    Dim lastRowSource As Long, lastRowTarget As Long, currentRow As Long
    Dim matchCell As Range
    
    ' Update these to your actual sheet names
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    Set wsTarget = ThisWorkbook.Sheets("Sheet2")
    
    ' Create or reuse the report sheet
    On Error Resume Next
    Set wsReport = ThisWorkbook.Sheets("ComparisonReport")
    On Error GoTo 0
    If wsReport Is Nothing Then
        Set wsReport = ThisWorkbook.Sheets.Add(After:=wsTarget)
        wsReport.Name = "ComparisonReport"
    End If
    
    ' Populate report headers
    wsReport.Range("A1:D1").Value = wsSource.Range("A1:D1").Value
    wsReport.Range("E1:G1").Value = Array("Subject1 Status", "Subject2 Status", "Artefact Status")
    
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' Compare entries from Sheet1 to Sheet2
    For currentRow = 2 To lastRowSource
        Set matchCell = wsTarget.Columns("A").Find(wsSource.Cells(currentRow, "A").Value, _
            LookIn:=xlValues, LookAt:=xlWhole)
        
        If Not matchCell Is Nothing Then
            ' Copy data and check differences
            wsReport.Cells(currentRow, "A").Resize(1, 4).Value = wsSource.Cells(currentRow, "A").Resize(1, 4).Value
            wsReport.Cells(currentRow, "E") = IIf(wsSource.Cells(currentRow, "B") <> wsTarget.Cells(matchCell.Row, "B"), "Mismatch", "Match")
            wsReport.Cells(currentRow, "F") = IIf(wsSource.Cells(currentRow, "C") <> wsTarget.Cells(matchCell.Row, "C"), "Mismatch", "Match")
            wsReport.Cells(currentRow, "G") = IIf(wsSource.Cells(currentRow, "D") <> wsTarget.Cells(matchCell.Row, "D"), "Mismatch", "Match")
        Else
            ' Mark entries only present in Sheet1
            wsReport.Cells(currentRow, "A").Resize(1, 4).Value = wsSource.Cells(currentRow, "A").Resize(1, 4).Value
            wsReport.Cells(currentRow, "E") = "Only in Sheet1"
        End If
    Next currentRow
    
    ' Add entries only present in Sheet2
    lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
    For currentRow = 2 To lastRowTarget
        Set matchCell = wsSource.Columns("A").Find(wsTarget.Cells(currentRow, "A").Value, _
            LookIn:=xlValues, LookAt:=xlWhole)
        
        If matchCell Is Nothing Then
            lastRowSource = wsReport.Cells(wsReport.Rows.Count, "A").End(xlUp).Row + 1
            wsReport.Cells(lastRowSource, "A").Resize(1, 4).Value = wsTarget.Cells(currentRow, "A").Resize(1, 4).Value
            wsReport.Cells(lastRowSource, "E") = "Only in Sheet2"
        End If
    Next currentRow
    
    ' Auto-adjust columns for readability
    wsReport.Columns.AutoFit
    MsgBox "Comparison complete! Check the ComparisonReport sheet for results."
End Sub

Run the macro, and it’ll generate a full report with matches, mismatches, and unique entries in seconds.

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