Question

我从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

Answer 1

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

接下来，您应该使用Excel.Worksheet类型的对象变量并遍历工作簿中的工作表：

使用VBA迭代Excel工作簿中的每个工作表

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

我将让您填写您的值捕获逻辑和比较循环：我注意到当您通过一次调用将一系列单元格提升为一个数组时，您正在使用高效的数据捕获方法sheet，并迭代数组。

最有效的输出方法是在单个“点击”中将数组写入工作表。但是，逐个格式化目标表单的需求会削弱性能增益。

[编辑：要求提供其他材料]

作为脚注，您可以使用以下VBA片段删除不需要的工作表：

wbkC.Worksheets("Sheet1").Delete

但是，此代码会出现警告：工作表名称与＆＃39; Sheet1＆＃39;不同。等国际版的MS-Office等。如果正在审查的工作簿中的一张表被称为“Sheet2＆＃39;”，那将是一件令人尴尬的事。

您可以尝试按序号wbkC.Worksheets（1）删除工作表。删除：wbkC.Worksheets（2）。删除等等：但如果序数不在您预期的范围内，那可能会令人尴尬在运行比较并创建新工作表之后......

我将让您在对象容器序列中查找意外行为的实际示例。

...所以答案是在工作簿上的操作之前删除wbkC中的工作表＆＃39; A＆＃39;和＆＃39; B＆＃39;。对此有一些神秘的防御性编码点：


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

你不能删除最后一张纸：我的建议是做一个必要的美德并重命名它＆＃39; Control＆＃39;或者＆＃39;审核＆＃39;并用它来写出文件的名称＆＃39; A＆＃39;和＆＃39; B＆＃39;使用用户名和时间戳。

当然，你是退出对象并在退出时删除数组。

Answer 2

新的工作表被添加到前面，因此可以通过强制将它们添加到最后，然后选择最后一个工作表来解决问题：

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

此外，＆＃34; ThisWorkbook.Activate＆＃34;应该在初始循环之前添加，以确保此代码发生在正确的工作簿中：

ThisWorkbook.Activate
For i = 1 To wbkA.Sheets.Count

Answer 3

Microsoft开发了一个实用程序来执行此操作，请参阅here

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

请注意，仅当您启用具有相同名称的COM插件时，才会显示功能区上的“INQUIRE”选项卡。

顺便提一下，如果要比较Access项目的VBA代码，请使用OASIS-SVN导出代码（以及其他对象defs。），然后使用git。

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

Answer 4

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

我想写这个来显示一个可用于提高速度的方法，并指出varSheetA和varSheetB变量不引用工作表上的单元格，而是实际存储来自单元格的值的副本内存中数组变量中的工作表。

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

我在新行附近添加了#HARVEY

让我知道你的想法。

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

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

4 个答案:

使用VBA迭代Excel工作簿中的每个工作表