VBA批量核对2个不同文件中多个工作表的内容

2016年12月15日21:44:55VBA批量核对2个不同文件中多个工作表的内容已关闭评论 8,329 views
微信公众号 【EXCEL880】 QQ群【341401932】
课程咨询 加我微信EXCEL880B 试学网址http://v.excel880.com

今天来看一个VBA自动核对工作表内容的例子。题目是这样的,现在有两个文件夹“标准”和“工作”,两个里面的文件是一样的,现在要将工作中所有Excel文件同标准中同名的Exel文件进行对比,如果有单元格内容不同就将工作文件夹中Excel的相应单元格用红色标注,并统计内容不同的单元格的个数。

先来说下思路,首先是要将两个工作表中的内容分别取出来,然后对取出来的内容依次进行对比,如果有不同的就将对应单元格标红,来看代码

Sub test()
Dim mypath1, mypath2, myfile, wb1, wb2, arr1, arr2, i, j, n
Application.ScreenUpdating = False
Application.DisplayAlerts = False
mypath1 = ThisWorkbook.Path & "/标准/"
mypath2 = ThisWorkbook.Path & "/工作/"
myfile = Dir(mypath2 & "*.xls")         '对工作文件夹中的Excel进行遍历
Do While myfile <> ""
Set wb1 = GetObject(mypath1 & myfile)   '打开标准中的对应Excel
arr1 = wb1.Sheets(1).Range("A1:E10")    '将相应内容存入数组arr1中
wb1.Close                               '关闭
Set wb2 = Workbooks.Open(mypath2 & myfile)   '打开工作文件夹中的同名Excel
arr2 = wb2.Sheets(1).Range("A1:E10")  '内容存入数组arr2
For i = 1 To UBound(arr2, 1)       '对arr2中的内容依次遍历
For j = 1 To UBound(arr2, 2)
If arr2(i, j) <> arr1(i, j) Then   '对比
n = n + 1                       '计数
wb2.Sheets(1).Cells(i, j).Interior.ColorIndex = 3   '标红
End If
Next
Next
wb2.Sheets(1).Range("J1") = n
wb2.Save                       '保存
wb2.Close                      '关闭
myfile = Dir                   '下一个
n = 0                          '重置计数器
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

在上面的代码中,打开标准文件夹中的Excel,将其中内容存入数组arr1中,之后需要将该Excel关闭,否则和后面的文件重名,后面的会打不开。之后再打开工作文件夹中的对应工作簿,相应内容还是存入数组中,之后对两个数组中对应内容进行比较。之前在GetObject的应用中我们说过如果保存的话工作簿就成了隐藏的了,所以这里我们选择了Open方法。

本节示例文件下载地址:http://pan.baidu.com/s/1hqmpLWC

表格 定制  数据 合并 处理 分析 VBA 编程 开发 网页