Vba 如何在excel中使用宏比较两个excel文件

我从stackoverflow中获取了一些代码，希望开发一个宏来比较两个excel工作簿和多个工作表，并突出显示不同的单元格值

我可以创建新的工作表，但无法将更改的数据复制并突出显示到单独的excel工作表中

当前代码会复制并突出显示差异，但会在一张工作表中覆盖以前复制和突出显示的数据

Private Sub CommandButton1_Click()

Dim varSheetA As Variant
Dim varSheetB As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long
Set wbkA = Workbooks.Open(Filename:="C:\macrotest\201566-15-00-DSEM-002-APP01.xlsm")
Set wbkB = Workbooks.Open(Filename:="C:\macrotest\testxl.xlsm")

For i = 1 To wbkA.Sheets.Count


Set varSheetA = wbkA.Worksheets(wbkA.Sheets(i).Name) 
Set varSheetB = wbkB.Worksheets(wbkB.Sheets(i).Name)
ThisWorkbook.Worksheets.Add().Name = wbkA.Sheets(i).Name
Sheets(i).Select

strRangeToCheck = "A1:DZ200"

Debug.Print Now
varSheetA = varSheetA.Range(strRangeToCheck)
varSheetB = varSheetB.Range(strRangeToCheck)
Debug.Print Now

For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
    For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
        If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then
            Cells(iRow, iCol) = varSheetA(iRow, iCol)
        Else
            Cells(iRow, iCol) = varSheetA(iRow, iCol)
            Cells(iRow, iCol).Interior.Color = RGB(255, 0, 0)
        End If
    Next
Next
Next i
End Sub

---

我认为你最好的答案是创建一个新的工作表，列出所做的更改，最好是在一个新的工作簿中

接下来，应使用Excel.Worksheet类型的对象变量，并在工作簿中的工作表中进行迭代：

Application.DisplayAlerts = False ' Suppress warning messages For i = wbkC.Worksheets.Count to 2 Step -1 wbkC.Worksheets(i).Delete Next i 使用VBA迭代Excel工作簿中的每个工作表

您不能删除最后一页：我的建议是，出于必要，将其重命名为“Control”或“Audit”，并使用它编写带有用户名和时间戳的文件“a”和“B”的名称

---

当然，您是在退出时丢弃对象并擦除数组

新图纸添加到前面，因此可以通过强制将其添加到末尾，然后选择最后一张图纸来解决问题：

Dim wbkA As Excel.Workbook Dim wshA As Excel.Worksheet
Dim wbkB As Excel.Workbook Dim wshB As Excel.Worksheet
Dim wbkC As Excel.Workbook Dim wshC As Excel.Worksheet
Set wbkC = Workbooks.Add wbkC.SaveAs "C:\macrotest\Changes.xlsx"
For Each wshA In wbkA.Worksheets
Set wshB = wbkB.Worksheets(wshA.Name) ' you will raise an error if no sheet of this name exists in B
Set wshC = wbkB.Worksheets.Add() wshC.Name = wshA.Name
' **** Implement your value-checking loop here **** ' wshC.Cells(iRow, iCol) = varSheetA(iRow, iCol)
Next wshA 此外，应在初始循环之前添加“ThisWorkbook.Activate”，以确保此代码发生在正确的工作簿中：

Application.DisplayAlerts = False ' Suppress warning messages For i = wbkC.Worksheets.Count to 2 Step -1 wbkC.Worksheets(i).Delete Next i

---

微软已经开发了一个实用程序来实现这一点

如果您可以通过Microsoft Office Professional Plus 2013或通过选定的Office 365订阅计划访问Excel 2013，则您可以访问Excel中的一个很棒的新功能，该功能允许您以电子方式比较两个工作簿，并识别这些工作簿中的任何差异。这项新功能——比较文件——功能强大，易于使用

请注意，仅当启用具有相同名称的COM加载项时，功能区上的“查询”选项卡才会显示

顺便说一句，如果要比较Access项目的VBA代码，请使用OASIS-SVN导出代码（和其他对象定义），然后使用git

---

（我很感激您可能需要编写自己的代码！但如果有工具可以帮助您，这是值得了解的。另外，也许是为了调试？

以下是我对这段代码所做的一些实验（尚未编译和运行）

我想写这篇文章是为了展示一种可以用来提高速度的方法，并指出varSheetA和varSheetB变量不引用工作表上的单元格，而是将工作表中单元格的值的副本存储在内存中的数组变量中

我已经添加了一个名为varNewValues的新数组，我使用它来操作将在新工作表上显示给用户的新值。使用数组比处理单元格更快，因此代码不再设置循环中单个单元格的值

我在新线附近加了哈维

让我知道你的想法

Worksheets.Add(After:=Sheets(Sheets.Count)).Name = wbkA.Sheets(i).Name
Sheets(Sheets.Count).Select

---

你是尼罗河的救世主。现在工作很完美。在生成Changes.xlsx时，还会出现“Sheet1”、“Sheet2”和“Sheet3”。如何删除它们？我知道这是个愚蠢的问题，但我不想把代码弄乱。万分感谢！扩展了答案：删除工作表听起来很简单-有一个.Delete（）方法-但是它需要比您在documentation.Nile中看到的更谨慎一点。在代码部分，您说如果在wbkB中找不到同名wkbA的工作表，我可能会引发错误。我试图提出一个错误，在此之前，它给了我一个运行时错误9：下标超出范围。如何处理该错误并使其恢复到与其他当前工作表的比较？“下标超出范围”确实是按名称请求集合成员的错误，而该名称不在集合中。这里没有“Exists”方法，所以如果出现此错误，您可以选择使用Resume Next编写错误处理程序；或者编写一个适当的“Name is in collection”函数，该函数按顺序枚举成员，读取其名称，如果匹配的成员名称存在，则返回TRUE。否。除非您正在复制和粘贴工作簿或工作表，或者希望用户立即查看特定的工作表，否则不需要激活工作簿或工作表。如果对象被显式声明和赋值，那么您调用的任何方法都将专门针对该对象。问题是运行“Cells（iRow，iCol）”而不是wbkA.wshA.Cells（iRow，iCol）-“Cells”如果没有限定符，将引用活动工作表但是显式引用链wbkA.wshA.Cells将完全按照它所说的去做。尼尔斯，我的解决方案并不是作为对你的解决方案的响应而写的——我在提交我的解决方案时，没有看到已经有了答案。我只是试图提供一个答案，只是稍微改变了代码，试图给用户一些想法来考虑或学习。我可能会建议，不要写一个以“不”开头的评论，也许你可以考虑写“我相信这是最好的”。不。不。从“不”开始，而不是“它比！”；-）事实上，他们确实开发了一个，你也可以：如果你是那种更深入研究这类问题的开发人员，你会感兴趣地知道微软这样做是为了应对电子表格监控软件这个利润丰厚的市场的增长。如果您有基于工具的电子表格比较的商业经验，CIMCON和客户甚至可能想和您谈谈。

Private Sub CommandButton1_Click()

    ' #HARVEY
    Dim varNewValues as variant 
    Dim Destination As Range

    ' Note that these are used as arrays that store the sheet's cells in memory
    Dim varSheetA As Variant
    Dim varSheetB As Variant

    Dim strRangeToCheck As String
    Dim iRow As Long
    Dim iCol As Long
    Set wbkA = Workbooks.Open(Filename:="C:\macrotest\201566-15-00-DSEM-002-APP01.xlsm")
    Set wbkB = Workbooks.Open(Filename:="C:\macrotest\testxl.xlsm")

    For Each wshA In wbkA.Worksheets

        Set varSheetB = wbkB.Worksheets(wshA.Name)

        Set wshC = wbkB.Worksheets.Add()
        wshC.Name = wshA.Name

        strRangeToCheck = "A1:DZ200"

        Debug.Print Now
        varSheetA = wbkA.Range(strRangeToCheck)
        varSheetB = wbkA.Range(strRangeToCheck)

        ' #HARVEY
        varNewValues = varSheetA

        Debug.Print Now

        For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
            For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
                If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then

                    ' #HARVEY
                    ' Do nothing as the value from wbkA  is already the varNewValues array              

                Else

                    ' #HARVEY
                    ' Add both cell values to the new sheet's array                 
                    varNewValues(iRow, iCol) = varSheetA(iRow, iCol) & ":" & varSheetB(iRow, iCol)

                    wshC.Cells(iRow, iCol).Interior.Color = RGB(255, 0, 0)
                End If
            Next
        Next

    Next 


    ' #HARVEY
    ' Copy the array value to the  wshC range
    Set Destination = wshC.Range("A1")

    Destination.Resize(UBound(varNewValues, 1), UBound(varNewValues, 2)).Value = varNewValues

End Sub