几年前刚学VBA,写过一个银行流水和ERP系统做账记录进行金额比对的工具。做为一名财务人员,经常会遇到这样的需求。
当时只是为了学习VBA字典,数组等知识而写,多年使用中发现有很多问题,最难受的就是效率一般,数据量特别大的时候,明显
有卡顿,一直想重新写一个,但平时实质比较忙,加上早已经不把VBA作为主技能树。所以一直没放在心上,最近有很多同事说喜
欢用我写的这个小工具,突然就有了一种责任感。于是重新写了一版。
一气呵成,简单的测试了一下。难免有逻辑漏洞,欢迎喜欢的朋友们下载使用,发现错误,提出建议。
地址是:下载地址
很久没有上传资源,今天上传一下发现下载积分是5,并且没找到可以修改积分的地方,对于我这样的爱好共享的人来说,实在不
忍心。所以把代码放下面。
你可以根据放到VBA的模块里。
Option Base 1
Sub compare()
Dim arr1, arr2 'arr1,2,分别存储2列原始数据
Dim restarr1(), restarr2() '分别存储arr1,2 相对多的数据 或者说结果要展示的2列数据
Dim i, j, k, m, n, start
Dim find As Boolean
Dim sh As Worksheet
Application.ScreenUpdating = False
Set sh = ThisWorkbook.Sheets("数据比对") '这个根据你自己的工作表设置
With sh
.Columns("e:h").ClearContents
'老样子数据分别A,C两列
'差异分别放在E G两列
arr1 = Application.Transpose(.Range("a2:a" & .[a65536].End(xlUp).Row))
arr2 = Application.Transpose(.Range("c2:c" & .[c65536].End(xlUp).Row))
End With
start = 1
k = 1
m = 1
[e1] = [a1] & "多的数据"
[g1] = [c1] & "多的数据"
On Error GoTo ErrCateg
For i = 1 To UBound(arr1)
find = False
For j = start To UBound(arr2)
If arr2(j) = arr1(i) Then
find = True
start = j + 1
Exit For
ElseIf arr2(j) > arr1(i) Then
start = j
Exit For
Else
ReDim Preserve restarr2(1 To k)
restarr2(k) = arr2(j)
k = k + 1
start = start + 1
End If
Next
If find = False Then '如果没有相等的,那么A列的这个数字就是 A列多出的。
ReDim Preserve restarr1(1 To m)
restarr1(m) = arr1(i)
m = m + 1
End If
Next
If start <= UBound(arr2) Then
For n = start To UBound(arr2)
ReDim Preserve restarr2(1 To k)
restarr2(k) = arr2(n)
k = k + 1
Next
End If
If m > 1 Then ' 如果A列有多的数据那么显示。 如果没有的话 下面的语句会出错,所以需要m 判断一下
[e2].Resize(m - 1, 1) = Application.Transpose(restarr1)
End If
If k > 1 Then
[g2].Resize(k - 1, 1) = Application.Transpose(restarr2)
End If
Application.ScreenUpdating = True
Exit Sub
ErrCateg:
MsgBox "请确保每列数据至少有2个!"
Application.ScreenUpdating = True
End Sub
补充:
因为是在原来的版本基础上修改代码。自动排序的代码没改动,所以没提供,如果需要的话请继续看下面。
在VBE中点击放数据的Sheet,然后选择 worksheet 对象的 change 方法
应该会自动把方法体构建好。最后代码如下:A,C,E,G是用到数据列以及差异展示列。请自己根据你的情况修改。
Private Sub Worksheet_Change(ByVal Target As Range)
Range("A:A").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Range("C:C").Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Range("E:E").Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Range("G:G").Sort Key1:=Range("G2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
End Sub