如何用vba实现两列数据的对账功能？

作者：绿色风分类：时间：2022-08-17 浏览：137

楼主
wcymiss

Q：如附件，A：D列与F:I列进行对账，依据是B列和G列。希望用vba实现：B列和G列相同的，在一行里显示；B列有而G列无的，F:I列显示空白；G列有而B列无的，在F:I最下方显示。
A：代码如下：

Sub 对账()
Dim d, arr, brr, crr(), i&, r1, r2, j&, drr
Set d = CreateObject("scripting.dictionary")
r1 = Cells(Rows.Count, "B").End(3).Row
r2 = Cells(Rows.Count, "G").End(3).Row
arr = Range("a3:d" & r1)
brr = Range("f3:i" & r2)
For i = 1 To r2 - 2
d(brr(i, 2)) = i
Next
ReDim Preserve crr(1 To 4, 1 To r1 - 2)
For i = 1 To r1 - 2
If d.exists(arr(i, 2)) Then
crr(1, i) = brr(d(arr(i, 2)), 1)
crr(2, i) = brr(d(arr(i, 2)), 2)
crr(3, i) = brr(d(arr(i, 2)), 3)
crr(4, i) = brr(d(arr(i, 2)), 4)
d(arr(i, 2)) = 0
If i = 140 Then
i = i
End If
End If
Next
drr = d.items
j = r1 - 2
For i = 0 To UBound(drr)
If drr(i) > 0 Then
j = j + 1
ReDim Preserve crr(1 To 4, 1 To j)
crr(1, j) = brr(drr(i), 1)
crr(2, j) = brr(drr(i), 2)
crr(3, j) = brr(drr(i), 3)
crr(4, j) = brr(drr(i), 4)
End If
Next
With Sheets("效果")
.Cells.ClearContents
.Columns("B:B").NumberFormatLocal = "@"
.Columns("G:G").NumberFormatLocal = "@"
Range("2:2").Copy .Range("2:2")
.[a3].Resize(UBound(arr), 4) = arr
.[f3].Resize(UBound(crr, 2), 4) = Application.Transpose(crr)
End With
Set d = Nothing
End Sub

4月对账用.rar

2楼
xyf2210

学习

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表