|
楼主 |
发表于 2020-9-23 16:21
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 新东写西读 于 2020-9-23 16:55 编辑
卡住了。。。
自己搜索论坛的资料进行调整,已经解决前面的问题了,只有最后一列的问题还没有搞定!
Sub 汇总对比()
Set d2 = CreateObject("Scripting.Dictionary")
arr = Sheets("确认数据").Range("C3:H" & Sheets("确认数据").[C65536].End(xlUp).Row)
arr1 = Sheets("发票数据").Range("B3:G" & Sheets("发票数据").[B65536].End(xlUp).Row)
ReDim arr2(1 To UBound(arr) + UBound(arr1), 1 To 10)
For i = 1 To UBound(arr)
s = d2(arr(i, 1) & arr(i, 2) & arr(i, 3))
If s = "" Then
d2(arr(i, 1) & arr(i, 2) & arr(i, 3)) = d2.Count
s = d2.Count
arr2(s, 1) = arr(i, 1)
arr2(s, 2) = arr(i, 2)
arr2(s, 3) = arr(i, 3)
End If
arr2(s, 4) = arr2(s, 4) + arr(i, 5)
arr2(s, 5) = arr2(s, 5) + arr(i, 6)
Next i
For i = 1 To UBound(arr1)
s = d2(arr1(i, 1) & arr1(i, 2) & arr1(i, 3))
If s = "" Then
d2(arr1(i, 1) & arr1(i, 2) & arr1(i, 3)) = d2.Count
s = d2.Count
arr2(s, 1) = arr1(i, 1)
arr2(s, 2) = arr1(i, 2)
arr2(s, 3) = arr1(i, 3)
End If
arr2(s, 6) = arr2(s, 6) + arr1(i, 5)
arr2(s, 7) = arr2(s, 7) + arr1(i, 6)
arr2(s, 8) = arr2(s, 4) - arr2(s, 6)
arr2(s, 9) = arr2(s, 5) - arr2(s, 7)
arr2(s, 10) = ""
Next i
Sheets("汇总对比").[A4].Resize(UBound(arr2), 10) = arr2
End Sub
|
|