楼主
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
|