Vba 比较2张excel工作表与常用键

我试图与excel表格进行比较，其中包含40000行和35列数据。 A列中有公用键，但两张表中的数据不同

第1页中可能有

A
B
C
D

在第2页中可能有

A
C
D
E

因此，我想比较两者，并在汇总表中提供差异。 我已经写了代码，但不知道如何完成它

Option Explicit

Sub Compare_Two_Excel_Files_Highlight_Differences()
    'Define Object for Excel Workbooks to Compare
    Dim sh As Integer, ShName As String, lColIdx As Long, sIdx As Long, ssh As String
    Dim F1_Workbook As Workbook, F2_Workbook As Workbook, statmsg As String, trialcnt As Long
    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, Header As String


    'Assign the Workbook File Name along with its Path
    File1_Path = ThisWorkbook.Sheets("Settings").Cells(2, 2)
    File2_Path = ThisWorkbook.Sheets("Settings").Cells(3, 2)
    iRow_Max = ThisWorkbook.Sheets("Settings").Cells(4, 2)
    iCol_Max = ThisWorkbook.Sheets("Settings").Cells(5, 2)
    lColIdx = ThisWorkbook.Sheets("Settings").Cells(6, 2).Interior.ColorIndex

    'Open Files To Compare
    Set F2_Workbook = Workbooks.Open(File2_Path)
    Set F1_Workbook = Workbooks.Open(File1_Path)

'    Windows("File1_Path.xlsx").Activate
'    Columns("A:A").Select
'    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'    Range("A1").Select
'    ActiveCell.FormulaR1C1 = "Key"
'    Range("A2").Select
'    Windows("File2_Path.xlsx").Activate
'    Columns("A:A").Select
'    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'    Range("A1").Select
'    ActiveCell.FormulaR1C1 = "Key"
'    Range("A2").Select


    '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
    sIdx = 1
'   trialcnt = 1
    Header = 1
    ThisWorkbook.Sheets("Summary").Cells.Clear
    ThisWorkbook.Sheets("Summary").Cells(sIdx, 3) = F1_Workbook.Name
    ThisWorkbook.Sheets("Summary").Cells(sIdx, 4) = F2_Workbook.Name
    ThisWorkbook.Sheets("Summary").Activate
    statmsg = Application.StatusBar
    For sh = 1 To F1_Workbook.Sheets.Count
        ShName = F1_Workbook.Sheets(sh).Name
        ThisWorkbook.Sheets("Settings").Cells(7 + sh, 1) = ShName
        ThisWorkbook.Sheets("Settings").Cells(7 + sh, 2) = "Identical Sheets"
        ThisWorkbook.Sheets("Settings").Cells(7 + sh, 2).Interior.Color = vbWhite
        Application.StatusBar = statmsg & " ,Processing Sheet: " & ssh

    '    If ThisWorkbook.Sheets("Settings").Cells(4, 2) = 0 Then iRow_Max = F1_Workbook.Sheets(ShName).Range("A:A").SpecialCells(xlLastCell).Row
    '    If ThisWorkbook.Sheets("Settings").Cells(5, 2) = 0 Then iCol_Max = F1_Workbook.Sheets(ShName).Range("A:A").SpecialCells(xlLastCell).Column
    '    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
        '   Find row number

        Dim Row As Long
        Dim i As Integer
    For i = 2 To ThisWorkbook.Sheets("Settings").Cells(4, 2).Value

        On Error Resume Next
        Row = Application.WorksheetFunction.Match(F1_Workbook.Sheets(ShName).Cells(i, 1).Value, F1_Workbook.Sheets(ShName).Range("A1:A200"), 0)


        On Error GoTo 0

        If lRow > 0 Then
        'code


'        If ThisWorkbook.Sheets("Settings").Cells(4, 2) = 0 Then iRow_Max = F1_Workbook.Sheets(ShName).Range("A:A").SpecialCells(xlLastCell).Row
'        If ThisWorkbook.Sheets("Settings").Cells(5, 2) = 0 Then iCol_Max = F1_Workbook.Sheets(ShName).Range("A:A").SpecialCells(xlLastCell).Column
'        For iRow = 1 To iRow_Max
'        For iCol = 1 To iCol_Max


        F1_Data = F1_Workbook.Sheets(ShName).Cells(i, iCol)
        F2_Data = F2_Workbook.Sheets(ShName).Cells(Row, iCol)


            If F1_Data <> F2_Data Then
  '             F1_Workbook.Sheets(ShName).Cells(iRow, iCol).Interior.ColorIndex = lColIdx
                ThisWorkbook.Sheets("Settings").Cells(7 + sh, 2) = "Mismatch Found"
                ThisWorkbook.Sheets("Settings").Cells(7 + sh, 2).Interior.ColorIndex = lColIdx
                If ssh <> F1_Workbook.Sheets(sh).Name Then
                    sIdx = sIdx + 1
                    ThisWorkbook.Sheets("Summary").Cells(sIdx, 3) = F1_Workbook.Sheets(sh).Name
                    ThisWorkbook.Sheets("Summary").Cells(sIdx, 4) = F2_Workbook.Sheets(sh).Name
                    ThisWorkbook.Sheets("Summary").Cells(sIdx, 1) = F1_Workbook.Sheets(ShName).Cells(1, 1).Value
                    ThisWorkbook.Sheets("Summary").Cells(sIdx, 2) = "Field"
                    ssh = F1_Workbook.Sheets(sh).Name

                End If
                sIdx = sIdx + 1
            '   ThisWorkbook.Sheets("Summary").Cells(sIdx, 1) = F1_Workbook.Sheets(ShName).Cells(iRow, iCol).Address
                ThisWorkbook.Sheets("Summary").Cells(sIdx, 2) = F1_Workbook.Sheets(ShName).Cells(Header, iCol).Value
                ThisWorkbook.Sheets("Summary").Cells(sIdx, 1) = F1_Workbook.Sheets(ShName).Cells(iRow, 1).Value
                ThisWorkbook.Sheets("Summary").Cells(sIdx, 3) = F1_Data
                ThisWorkbook.Sheets("Summary").Cells(sIdx, 4) = F2_Data
                ThisWorkbook.Sheets("Summary").Cells(sIdx, 2).Select
            End If
   '     Next iCol


        ThisWorkbook.Sheets("Settings").Cells(7 + sh, 2) = ThisWorkbook.Sheets("Settings").Cells(7 + sh, 2) & " (" & iRow_Max & "-Rows , " & iCol_Max & "-Cols Compared)"
  '  Next sh

    Next i
End If
Trial_Exit:
    '''''Process Completed
    F2_Workbook.Close savechanges:=False
    F1_Workbook.Close savechanges:=True
    Set F2_Workbook = Nothing
    Set F1_Workbook = Nothing
    ThisWorkbook.Sheets("Settings").Activate
    MsgBox "Task Completed"
    Application.StatusBar = statmsg

 '   End With
 '   ThisWorkbook.Sheets("Settings").Cells(1, 4).Font.Color = vbRed
End Sub

选项显式
子比较\u两个\u Excel\u文件\u突出显示\u差异（）
'为Excel工作簿定义要比较的对象
Dim sh为整数，ShName为字符串，lColIdx为长，sIdx为长，ssh为字符串
将F1_工作簿设置为工作簿，F2_工作簿设置为工作簿，statmsg设置为字符串，trialcnt设置为长
Dim iRow为双精度，iCol为双精度，iRow_Max为双精度，iCol_Max为双精度
Dim File1_路径作为字符串，File2_路径作为字符串，F1_数据作为字符串，F2_数据作为字符串，标题作为字符串
'指定工作簿文件名及其路径
File1_Path=ThisWorkbook.Sheets（“设置”）.Cells（2，2）
File2_Path=ThisWorkbook.Sheets（“Settings”）.Cells（3,2）
iRow_Max=此工作簿.工作表（“设置”）.单元格（4,2）
iCol_Max=ThisWorkbook.Sheets（“Settings”）.单元格（5,2）
lColIdx=ThisWorkbook.Sheets（“Settings”）.Cells（6,2）.Interior.ColorIndex
'打开要比较的文件
设置F2\u工作簿=工作簿。打开（文件2\u路径）
设置F1\u工作簿=工作簿。打开（文件1\u路径）
'Windows（“File1_Path.xlsx”）。激活
'列（“A:A”）。选择
'选择。插入Shift:=xlToRight，CopyOrigin:=xlFormatFromLeftOrAbove
'范围（“A1”）。选择
'ActiveCell.FormulaR1C1=“键”
'范围（“A2”）。选择
'Windows（“File2_Path.xlsx”）。激活
'列（“A:A”）。选择
'选择。插入Shift:=xlToRight，CopyOrigin:=xlFormatFromLeftOrAbove
'范围（“A1”）。选择
'ActiveCell.FormulaR1C1=“键”
'范围（“A2”）。选择
'使用F1_工作簿对象，现在可以从中提取任何数据
'从两个Excel文件的每张表中读取数据并比较数据
sIdx=1
'trialcnt=1
标题=1
此工作簿.Sheets（“Summary”）.Cells.Clear
ThisWorkbook.Sheets（“Summary”）.Cells（sIdx，3）=F1_Workbook.Name
ThisWorkbook.Sheets（“Summary”）.Cells（sIdx，4）=F2_工作簿.Name
此工作簿。工作表（“摘要”）。激活
statsg=Application.StatusBar
对于sh=1到F1\u工作簿.Sheets.Count
ShName=F1\u工作簿.工作表（sh）.Name
ThisWorkbook.Sheets（“Settings”）.Cells（7+sh，1）=ShName
此工作簿.Sheets（“设置”）.Cells（7+sh，2）=“相同的工作表”
此工作簿.Sheets（“Settings”）.Cells（7+sh，2）.Interior.Color=vbWhite
Application.StatusBar=statsg&“，处理表：”&ssh
'如果ThisWorkbook.Sheets（“设置”）.Cells（4，2）=0，则iRow_Max=F1_Workbook.Sheets（ShName）.Range（“A:A”）.SpecialCells（xlLastCell）.Row
'如果ThisWorkbook.Sheets（“设置”）.Cells（5，2）=0，则iCol_Max=F1_Workbook.Sheets（ShName）.Range（“A:A”）.SpecialCells（xlLastCell）.Column
'对于iRow=1到iRow_Max
'对于iCol=1至iCol_Max
'F1_Data=F1_工作簿.Sheets（ShName）.Cells（iRow，iCol）
'F2_Data=F2_工作簿.Sheets（ShName）.Cells（iRow，iCol）
'比较Excel工作表中的数据并突出显示不匹配项
'查找行号
暗排一样长
作为整数的Dim i
对于i=2的ThisWorkbook.Sheets（“Settings”）.Cells（4,2）.Value
出错时继续下一步
行=Application.WorksheetFunction.Match（F1_工作簿.Sheets（ShName）.Cells（i，1）.Value，F1_工作簿.Sheets（ShName）.Range（“A1:A200”），0）
错误转到0
如果lRow>0，则
“代码
'如果ThisWorkbook.Sheets（“设置”）.Cells（4，2）=0，则iRow_Max=F1_Workbook.Sheets（ShName）.Range（“A:A”）.SpecialCells（xlLastCell）.Row
'如果ThisWorkbook.Sheets（“设置”）.Cells（5，2）=0，则iCol_Max=F1_Workbook.Sheets（ShName）.Range（“A:A”）.SpecialCells（xlLastCell）.Column
'对于iRow=1到iRow_Max
'对于iCol=1至iCol_Max
F1_数据=F1_工作簿.工作表（ShName）.单元格（i，iCol）
F2_数据=F2_工作簿.工作表（ShName）.单元格（行，iCol）
如果F1_数据F2_数据，则
'F1_工作簿.Sheets（ShName）.Cells（iRow，iCol）.Interior.ColorIndex=lColIdx
ThisWorkbook.Sheets（“设置”）.Cells（7+sh，2）=“发现不匹配”
此工作簿.Sheets（“Settings”）.Cells（7+sh，2）.Interior.ColorIndex=lColIdx
如果ssh F1_工作簿.Sheets（sh）.Name，则
sIdx=sIdx+1
ThisWorkbook.Sheets（“Summary”）.Cells（sIdx，3）=F1_工作簿.Sheets（sh）.Name
ThisWorkbook.Sheets（“Summary”）.Cells（sIdx，4）=F2_工作簿.Sheets（sh）.Name
ThisWorkbook.Sheets（“Summary”）.Cells（sIdx，1）=F1_Workbook.Sheets（ShName）.Cells（1，1）.Value
此工作簿.Sheets（“Summary”）.Cells（sIdx，2）=“字段”
ssh=F1\u工作簿.Sheets（sh）.Name
如果结束
sIdx=sIdx+1
'ThisWorkbook.Sheets（“Summary”）.Cells（sIdx，1）=F1_Workbook.Sheets（ShName）.Cells（iRow，iCol）.地址
ThisWorkbook.Sheets（“Summary”）.Cells（sIdx，2）=F1_Workbook.Sheets（ShName）.Cells（Header，iCol）.Value
ThisWorkbook.Sheets（“Summary”）.Cells（sIdx，1）=F1_Workbook.Sheets（ShName）.Cells（iRow，1）.Value
此工作簿.Sheets（“Summary”）.Cells（sIdx，3）=F1\U数据
此工作簿.Sheets（“Summary”）.Cells（sIdx，4）=F2_数据
此工作簿.Sheets（“Summary”）.Cells（sIdx，2）。选择
如果结束
“下一个iCol
ThisWorkbook.Sheets（“设置”）.Cells（7+sh，2）=ThisWorkbook.Sheets（“设置”）.Cells（7+sh，2）和“（&iRow\U Max&&Rows，&iCol\U Max&&Cols比较）”
“下一个嘘
接下来我
如果结束
试验出口：
“完成”过程
F2\u工作簿。关闭保存更改：=False
F1\u工作簿。关闭保存更改：=真
设置F2_工作簿=无
设置F1\u工作簿=无
此工作簿.Sheets（“Se
Sub wsCompare()
    Dim ws1 As Worksheet, ws2 As Worksheet, wsResults As Worksheet
    Dim strKey As String
    Dim lngFindKey As Long
    Dim rngFindKey As Range

    Set ws1 = Sheets("Sheet1") 'set this to your first worksheet with data
    Set ws2 = Sheets("Sheet2") 'set this to your second worksheet with data
    Set wsResults = Sheets("Sheet3") 'set this to the worksheet with the results in it

    For i = 1 To 4000 'update this to be the first row containing an ID to the last
        strKey = ws1.Range("A" & i).Value
        Set rngFindKey = ws2.Range("A:A").Find(WHAT:=strKey)
        lngFindKey = rngFindKey.Row

        For x = 1 To 35
            If x = 1 Then
                wsResults.Range("A" & i).Value = strKey
            Else
                'add code to calc your difference assuming all numerical values do something like this
                wsResults.Range(Cells(i, x)).Value = ws2.Range(Cells(longFindKey, x)).Value - ws1.Range(Cells(i, x)).Value
            End If
        Next x
    Next i

End Sub