VBA比较2个Excel文件差异工具

后文的代码以及实现的完整都在如下Github文件上可以找到
vba比较2个excel差异工具

实现效果如下图：

实现原理：

Sub 按钮3_Click()

    Dim wb1, wb2 As Workbook
    Dim sheetNum, colNum, rowNum As Integer
    Dim sheet1, Sheet2, sheetTarget As Worksheet
    Dim diffName As String
    Dim name1, name2 As String
    Dim version1, version2 As String
    Dim a() As String
    Dim xlMerge As Range
    Dim totalValue(1000) As Variant  '总行数，超过1000行会出错
    Dim total As Integer

    If (Dir(Cells(1, 2).Value) <> "") And (Dir(Cells(2, 2).Value) <> "") Then
        Set wb1 = Workbooks.Open(ThisWorkbook.Worksheets("config").Cells(1, 2).Value)
        Set wb2 = Workbooks.Open(ThisWorkbook.Worksheets("config").Cells(2, 2).Value)
        
        'get file name
        name1 = ThisWorkbook.Worksheets("config").Cells(1, 2).Value
        name2 = ThisWorkbook.Worksheets("config").Cells(2, 2).Value
    
        a = Split(name1, "\")
        version1 = a(UBound(a))
    
        a = Split(name2, "\")
        version2 = a(UBound(a))
        
        'delete xxx_diff sheets
        Application.DisplayAlerts = False
        For Each ws In ThisWorkbook.Worksheets
            If InStr(ws.name, "diff") > 0 Then
                ws.Delete
            End If
        Next
        Application.DisplayAlerts = True
        
        sheetNum = wb1.Worksheets.Count
        '在当前表格的最后面新建表格
        For i = 1 To sheetNum
            diffName = wb1.Worksheets(i).name + "_diff"
             'add a sheet named xxx_diff
            ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).name = diffName
        Next i
        
        
        For i = 1 To sheetNum
            diffName = wb1.Worksheets(i).name + "_diff"
            Set sheetTarget = ThisWorkbook.Worksheets(diffName)
            
            sheetTarget.Activate
            sheetTarget.Select
            
            sheetTarget.Rows(2).Select
        
            Set sheet1 = wb1.Worksheets(i)
            Set Sheet2 = wb2.Worksheets(i)
            rowNum = sheet1.UsedRange.Rows.Count
            colNum = sheet1.UsedRange.Columns.Count
            
            Dim cnt As Integer
            
            For cnt = 0 To UBound(totalValue) - 1
                totalValue(cnt) = ""
            Next cnt
            
            total = 0
            
            For cnt = 2 To sheet1.UsedRange.Rows.Count
                totalValue(cnt - 2) = sheet1.Cells(cnt, 1)
                total = sheet1.UsedRange.Rows.Count - 1
            Next cnt
            
            Dim findposition As Integer
            For cnt = 2 To Sheet2.UsedRange.Rows.Count
                    findposition = Application.IfError(Application.Match(Sheet2.Cells(cnt, 1), totalValue, 0), -1)
                    If findposition = -1 Then
                        totalValue(total) = Sheet2.Cells(cnt, 1)
                        total = total + 1
                    End If

            Next cnt
            
            '初始化第1列，从第3行开始
            For j = 3 To total + 2
                sheetTarget.Cells(j, 1).Value = totalValue(j - 3)
            Next j
            
            '初始化行
            For k = 1 To colNum
                If k = 1 Then
                    '表格的第1列从目标表格的第3行开始
                    sheetTarget.Cells(2, k).Value = sheet1.Cells(1, k)
                Else
                    '从第2列开始，每个列分成3列
                    Application.DisplayAlerts = False
                    '第1列
                    sheetTarget.Cells(1, 3 * k - 4).Value = sheet1.Cells(1, k)
                    
                    '合并3个单元格
                    With sheetTarget.Range(sheetTarget.Cells(1, 3 * k - 4), sheetTarget.Cells(1, 3 * k - 2))
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                        .Merge
                    End With
                    
                    '新增加3列，表格1，表格2，以及2个表格的内容是否相同
                    sheetTarget.Cells(2, 3 * k - 4).Value = version1
                    sheetTarget.Cells(2, 3 * k - 3).Value = version2
                    sheetTarget.Cells(2, 3 * k - 2).Value = "是否一致"
                    Application.DisplayAlerts = True
                End If
            Next k
            
            sheetTarget.Activate
            
            
            '填充数据
            For j = 3 To total + 2
                '选中当前行，实现每行动态刷新
                sheetTarget.Rows(j).Select
                For k = 2 To colNum
                    sheetTarget.Cells(j, 3 * k - 4).Value = Application.IfError(Application.VLookup(totalValue(j - 3), sheet1.Range("A:F"), k, False), "")
                    sheetTarget.Cells(j, 3 * k - 3).Value = Application.IfError(Application.VLookup(totalValue(j - 3), Sheet2.Range("A:F"), k, False), "")
                    If sheetTarget.Cells(j, 3 * k - 4).Value = sheetTarget.Cells(j, 3 * k - 3).Value Then
                        sheetTarget.Cells(j, 3 * k - 2).Value = "是"
                    Else
                        sheetTarget.Cells(j, 3 * k - 2).Value = "否"
                    End If
                    '左边的版本号比右边的大,只标第一个apk_diff表格，且只标记版本号那一列
                    If StrComp(sheetTarget.Cells(j, 3 * k - 4).Value, sheetTarget.Cells(j, 3 * k - 3).Value, 1) = 1 And k = 2 And sheetTarget.Cells(j, 3 * k - 3).Value <> "" And i = 1 Then
                        sheetTarget.Cells(j, 3 * k - 2).Interior.Color = vbYellow '设置填充为黄色
                    End If
                Next k
                delayTime (0.15)
            Next j
            
            
        Next i
        
        wb1.Close
        wb2.Close
    Else
        MsgBox "请选择要比较的表格"
    End If

End Sub

Function delayTime(T As Single)

    Dim t1 As Single
    t1 = Timer
    Do
    
    Loop While Timer - t1 < T
    
End Function

有个设置延时的地方

delayTime (0.15)

是因为执行脚本的时候有点卡，可以把这个时间相应的改大一些；但是如果设置的太大，执行的时候会相应的变长

TBD：
在查找每一行的值的时候，都是用vlookup来查找的，这个过程可以优化，在统计totalValue总行数的时候，已经对比过一次，可以把相应的值保存起来，用空间换时间