首页 文章

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

提问于
浏览
0

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

4 回答

  • 2

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

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

    此外,应在初始循环之前添加“ThisWorkbook.Activate”以确保此代码发生在正确的工作簿中:

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

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

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

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

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

    (我感谢您可能需要编写自己的代码!,但是如果一个工具可以帮助您,这值得了解 . 另外,也许是为了调试?)

  • 0

    这是我用这段代码做的一些实验(它还没有编译和运行)

    我想写这个来显示一个方法,可以用来提高速度,并指出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
    
  • 0

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

    接下来,您应该使用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
    

    我将让你填写你的值捕获逻辑和比较循环:我注意到当你在一次调用每个工作表时将一系列单元格提升为一个数组时,你正在使用一种有效的数据捕获方法,并重复阵列 .

    最有效的输出方法是在单个“命中”中将数组写入工作表;然而,逐个格式化目标表单的需求侵蚀了性能增益 .

    [编辑:要求的其他材料]

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

    wbkC.Worksheets("Sheet1").Delete

    但是,此代码附带警告:在国际版本的MS-Office中,工作表名称将与“Sheet1”等不同 . 如果正在检查的工作簿中的一张被称为“Sheet2”,那将是一件令人尴尬的事情 .

    您可以尝试按序号wbkC.Worksheets(1)删除工作表 . 删除:wbkC.Worksheets(2) . 删除等等:但是如果在执行比较之后,如果序数不在您期望的范围内,那可能会令人尴尬创建新表...

    我会让你在对象容器序列中寻找意外行为的实际例子 .

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

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

    您可以使用用户名和时间戳来控制' or '审计' and use it to write the names of files ' A ' and ' B' .

    当然,你在退出时解雇对象并擦除数组 .

相关问题