|
除非注明，文章均为 战战如疯 原创，转载请保留链接: http://www./cat4/345.html，VBA交流群273624828。
今天来看一个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。
|
