作者：绿色风
分类：
时间：2022-08-17
浏览：72
楼主
liuguansky |
Q:如何依多条件合并相关项目，并筛选合并后的记录返回？[即依订单号，说明，单价三者进行汇总数量与金额，同时对返回的汇总记录进行负数删除的筛选]
A:用如下代码可以实现。
- Sub justtest()
- Dim dic, i&, arr1, arr2, arr, str1$, str2$
- Set dic = CreateObject("scripting.dictionary")
- For i = 2 To Cells(Rows.Count, 4).End(3).Row
- str1 = Cells(i, 4).Value & vbTab & Cells(i, 6).Value & vbTab & Cells(i, 8).Value
- str2 = Join(Application.Transpose(Application.Transpose(Cells(i, 1).Resize(1, 10))), vbTab)
- If dic.exists(str1) Then
- arr = Split(str2, vbTab)
- arr(6) = Val(Split(dic(str1), vbTab)(6)) + Val(arr(6))
- arr(8) = Val(Split(dic(str1), vbTab)(8)) + Val(arr(8))
- dic(str1) = Join(arr, vbTab)
- Else: dic.Add str1, str2
- End If
- Next
- arr1 = dic.items
- For i = LBound(arr1) To UBound(arr1)
- If Val(Split(arr1(i), vbTab)(6)) < 0 Or Val(Split(arr1(i), vbTab)(8)) < 0 Then
- arr3 = Split(arr1(i), vbTab)
- dic.Remove arr3(3) & vbTab & arr3(5) & vbTab & arr3(7)
- End If
- Next
- With Sheets("sheet2")
- .Cells.Clear
- .Range("a1:j1").Value = Range("a1:j1").Value
- If dic.Count > 0 Then
- arr2 = dic.items
- For i = 2 To dic.Count + 1
- .Cells(i, 1).Resize(1, 10) = Application.Transpose(Application.Transpose(Split(arr2(i - 2), vbTab)))
- Next i
- End If
- .Range("a:j").EntireColumn.AutoFit
- .Select
- End With
- Erase arr
- Erase arr1
- Erase arr2
- Set dic = Nothing
- End Sub
|
2楼
海洋之星 |
学习了,哈哈,花花 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一