如何对比各含3个指定工作表的两个Excel工作簿

我正在推进一个项目，目前能力不足以完成需求，具体需求如下：

• 对比两个Excel工作簿，两者都包含WireList、Cumulated BOM、BOM三个工作表
• 实现选择文件1和文件2后，自动对所有对应工作表进行对比
• 输出结果需包含两种视图：一是各工作表的匹配状态概览，二是具体的差异明细展示

我尝试过两段VBA代码，但作为新手仍无法实现目标，希望能获得帮助。

代码示例1（基础对比功能） #

Option Explicit
Sub Compare()
    'Define Object for Excel Workbooks to Compare
    Dim sh As Integer, shName As String
    Dim F1_Workbook As Workbook, F2_Workbook As Workbook
    Dim iRow As Double, iCol As Double, iRow_Max As Double, iCol_Max As Double
    Dim File1_Path As String, File2_Path As String, F1_Data As String, F2_Data As String
    
    'Assign the Workbook File Name along with its Path
    File1_Path = ThisWorkbook.Sheets(1).Cells(1, 2)
    File2_Path = ThisWorkbook.Sheets(1).Cells(2, 2)
    iRow_Max = ThisWorkbook.Sheets(1).Cells(3, 2)
    iCol_Max = ThisWorkbook.Sheets(1).Cells(4, 2)

    Set F2_Workbook = Workbooks.Open(File2_Path)
    Set F1_Workbook = Workbooks.Open(File1_Path)
    ThisWorkbook.Sheets(1).Cells(6, 2) = F1_Workbook.Sheets.Count
    
    'With F1_Workbook object, now it is possible to pull any data from it
    'Read Data From Each Sheets of Both Excel Files & Compare Data
    For sh = 1 To F1_Workbook.Sheets.Count
        shName = F1_Workbook.Sheets(sh).Name
        ThisWorkbook.Sheets(1).Cells(7 + sh, 1) = shName
        ThisWorkbook.Sheets(1).Cells(7 + sh, 2) = "Identical Sheets"
        ThisWorkbook.Sheets(1).Cells(7 + sh, 2).Interior.Color = vbGreen
        
        For iRow = 1 To iRow_Max
        For iCol = 1 To iCol_Max
            F1_Data = F1_Workbook.Sheets(shName).Cells(iRow, iCol)
            F2_Data = F2_Workbook.Sheets(shName).Cells(iRow, iCol)
            
            'Compare Data From Excel Sheets & Highlight the Mismatches
            If F1_Data <> F2_Data Then
                F1_Workbook.Sheets(shName).Cells(iRow, iCol).Interior.Color = vbYellow
                ThisWorkbook.Sheets(1).Cells(7 + sh, 2) = "Mismatch Found"
                ThisWorkbook.Sheets(1).Cells(7 + sh, 2).Interior.Color = vbYellow
            End If
        Next iCol
        Next iRow
    Next sh
    
    'Process Completed
    ThisWorkbook.Sheets(1).Activate
    MsgBox "Task Completed - Thanks for Visiting OfficeTricks.Com"
    
End Sub

代码示例2（进阶对比功能） #

Option Explicit

Sub test_CompareSheets_Adv()

ActiveWorkbook.Activate

If SheetExists("results") = False Then
    Sheets.Add
    ActiveSheet.Name = "results"
End If

If CompareSheets_Adv("Sheet3", "Sheet4") = True Then
    MsgBox " Completed Successfully!"
    Else
    MsgBox "Process Failed"
End If

End Sub
Function CompareSheets_Adv(sh1Name$, sheet2name$) As Boolean

Dim vstr As String
Dim vData As Variant
Dim vitm As Variant
Dim vArr As Variant
Dim v()

Dim a As Long
Dim b As Long
Dim c As Long

On Error GoTo CompareSheetsERR

vData = Sheets(sh1Name$).Range("A1:T6817").Value

With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        
        ReDim v(1 To UBound(vData, 2))
        
        For a = 2 To UBound(vData, 1)
            
            For b = 1 To UBound(vData, 2)
                vstr = vstr & Chr(2) & vData(a, b)
                v(b) = vData(a, b)
            Next
            
            .Item(vstr) = v
            vstr = ""
            
        Next
        
        vData = Sheets(sheet2name$).Range("A1:T6817").Value

        
        For a = 2 To UBound(vData, 1)
            
            For b = 1 To UBound(vData, 2)
                vstr = vstr & Chr(2) & vData(a, b)
                v(b) = vData(a, b)
            Next
        
            If .exists(vstr) Then
                .Item(vstr) = Empty
                Else
                .Item(vstr) = v
            End If
            
            vstr = ""
        Next
        
        For Each vitm In .keys
            If IsEmpty(.Item(vitm)) Then
            .Remove vitm
            End If
        Next
            
        vArr = .items
        c = .Count

End With

With Sheets("Results").Range("a1").Resize(, UBound(vData, 2))

    .Cells.Clear
    .Value = vData
    
    If c > 0 Then
        .Offset(1).Resize(c).Value = Application.Transpose(Application.Transpose(vArr))
    End If
    
End With

CompareSheets_Adv = True

Exit Function
CompareSheetsERR:
CompareSheets_Adv = False

End Function

Function SheetExists(shName As String) As Boolean
    With ActiveWorkbook
        On Error Resume Next
        SheetExists = (.Sheets(shName).Name = shName)
        On Error GoTo 0
    End With
    
End Function

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