如何用字典返回货号相同但价格不同的明细?

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

楼主
liuguansky

Q:如何返回货号相同的情况下,如果存在价格不同的品名,则返回价格不同的明细?
A:用如下代码可以实现:

Sub justtest() '需在VBE工具下引用MS SCRIPTING.RUNTIME
Dim d As New Dictionary, arr, i&, dd, k&, arrt(), j%, artemp '定义变量
arr = Range("a1:c" & Cells(Rows.Count, 1).End(3).Row).Value '获取待处理数据,赋予数组
For i = 2 To UBound(arr, 1) '循环数组
If Not d.Exists(arr(i, 1)) Then
d.Add arr(i, 1), "": Set d(arr(i, 1)) = New Dictionary '字典套字典
End If
If Not d(arr(i, 1)).Exists(arr(i, 2)) Then
d(arr(i, 1)).Add arr(i, 2), i
End If
Next i
For Each dd In d.Keys '对字典的子字典项进行判断处理
If d(dd).Count > 1 Then ' 如果存在子字典不重项,则
For i = 1 To d(dd).Count
k = k + 1
ReDim Preserve arrt(1 To 3, 1 To k)
artemp = d(dd).Items
For j = 1 To 3
arrt(j, k) = arr(artemp(i - 1), j)
Next j
Next i
End If
Next
Range("e:g").ClearContents
Range("e1:g1") = Application.Index(arr, 1, 0)
Range("e2").Resize(k, 3) = Application.Transpose(arrt)
End Sub

2楼
亡者天下

要是有附件测试一下就更好了！

免责声明

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

评论列表