如何使用Excel中的macros比较两个Excel文件

我已经拿起了从计算器的代码,并希望开发一个macros,比较两个Excel工作簿与多个工作表,并突出显示不同的单元格值。

我能够创build新的工作表,但我无法复制和突出显示更改后的数据到单独的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 

我认为你最好的答案是创build一个列表变化的新表,最好在一个新的工作簿。

接下来,您应该使用Excel.Worksheettypes的对象variables并遍历工作簿中的工作表:

使用VBA在Excel工作簿中遍历每个工作表

 Dim wbkA As Excel.Workbook
昏暗wshA作为Excel.Worksheet 
Dim wbkB As Excel.Workbook Dim wshB As Excel.Worksheet
Dim wbkC As Excel.Workbook 昏暗的wshC作为Excel.Worksheet
设置wbkC = Workbooks.Add wbkC.SaveAs“C:\ macrotest \ Changes.xlsx”
对于每个wshA在wbkA.Worksheets
设置wshB = wbkB.Worksheets(wshA.Name) 如果B中没有这个名字的表格,你将会报错
设置wshC = wbkB.Worksheets.Add() wshC.Name = wshA.Name
'****在这里实现您的值检查循环**** 'wshC.Cells(iRow,iCol)= varSheetA(iRow,iCol)
下一个wshA

我将留给您填写您的值捕获逻辑和比较循环:我注意到,当您将一个单元格范围内的单元格提升到一个数组中时,您正在使用有效的数据捕获方法,然后迭代arrays。

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

[编辑:附加材料请求]

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

wbkC.Worksheets("Sheet1").Delete

但是,这段代码带有一个警告:在MS-Office的国际版本中,图表名称与“Sheet1”等不同。 如果被检查的工作簿中的一张表被称为“工作表2”,这将是一件令人尴尬的事情。

你可以尝试删除由顺序wbkC.Worksheets(1)删除表:删除:wbkC.Worksheets(2)。删除等:但这可能会令人尴尬,如果序数不是你期望他们在比较后,创build新的工作表…

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

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

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

你不能删除最后一张表格,我的build议是做一个必要的优点,把它重新命名为“控制”或“审计”,并用它来写出用户名和文件名“A”和“B”一个时间戳。

当然,你是解散对象,并在退出时擦除arrays。

新的工作表被添加到前面,所以问题可以通过强制他们被添加到最后,然后select最后一个工作表来解决:

 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 

微软已经开发了一个实用工具来完成这个工作

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

请注意function区上的“查询”选项卡只有在启用具有相同名称的COM插件时才会显示。

顺便说一句,如果你想比较Access项目的VBA代码使用OASIS-SVN导出代码(和其他对象defs。),然后使用git。

(我很感谢你可能需要编写你自己的代码!但是如果一个工具能够帮助你,这个值得了解。另外,也许是为了debugging?)

这里有一些我用这个代码做的实验(它没有被编译和运行)

我想写这个来显示一个可以用来提高速度的方法,并指出varSheetA和varSheetBvariables不引用表单上的单元格,而是实际存储表单单元格中的值的副本内存中的数组variables。

我添加了一个名为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