课程咨询 加我微信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。