[已解决]VBA求和

moming0211

有一原数量表。需根据客户，订单和产品相同的来汇总数量。新人只有在二列数据的情况下用字典来求和的案例，这个原表里有多列，请高手指点。谢谢。---描述失误。

最佳答案

月排行榜 / 总排行榜

云影

2014-5-15 14:32

1. Sub test()
   
2.    Dim arr, ar1, ar2
   
3.    Dim x%, i%, k%
   
4.    Dim d1 As Object, d2 As Object
   
5.    Set d1 = CreateObject("scripting.dictionary")
   
6.    Set d2 = CreateObject("scripting.dictionary")
   
7.       arr = Range("a3:d" & Cells(Rows.Count, 1).End(3).Row)
   
8.       ar1 = [f5:i16]: ar2 = [k5:n16]
   
9.          For x = 1 To UBound(ar1)
   
10.             d1(ar1(x, 1)) = ar1(x, 2) & "-" & ar1(x, 3) & "-" & ar1(x, 4)
    
11.             d2(ar2(x, 1)) = ar2(x, 2) & "-" & ar2(x, 3) & "-" & ar2(x, 4)
    
12.          Next x
    
13.          For i = 2 To UBound(arr)
    
14.             If InStr(arr(i, 3), "PD") Or InStr(arr(i, 3), "PD") Then
    
15.                k = Application.Match(arr(i, 2), [{15,24,40}]) - 1
    
16.                arr(i, 4) = Split(d1(arr(i, 1)), "-")(k)
    
17.             Else
    
18.                k = Application.Match(arr(i, 2), [{15,24,40}]) - 1
    
19.                arr(i, 4) = Split(d2(arr(i, 1)), "-")(k)
    
20.             End If
    
21.          Next i
    
22.   Range("a3").Resize(i - 1, 4) = arr
    
23. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

需要更多的说明
1、是否PD、PY。。。。各出一张表
2、D列的数字是怎么出来的
3、输出表中的15-20        24-30        40-50 是什么意思。
4、输出表中的黄色部分填什么内容。

云影

1. Sub test()
   
2.    Dim arr, ar1, ar2
   
3.    Dim x%, i%, k%
   
4.    Dim d1 As Object, d2 As Object
   
5.    Set d1 = CreateObject("scripting.dictionary")
   
6.    Set d2 = CreateObject("scripting.dictionary")
   
7.       arr = Range("a3:d" & Cells(Rows.Count, 1).End(3).Row)
   
8.       ar1 = [f5:i16]: ar2 = [k5:n16]
   
9.          For x = 1 To UBound(ar1)
   
10.             d1(ar1(x, 1)) = ar1(x, 2) & "-" & ar1(x, 3) & "-" & ar1(x, 4)
    
11.             d2(ar2(x, 1)) = ar2(x, 2) & "-" & ar2(x, 3) & "-" & ar2(x, 4)
    
12.          Next x
    
13.          For i = 2 To UBound(arr)
    
14.             If InStr(arr(i, 3), "PD") Or InStr(arr(i, 3), "PD") Then
    
15.                k = Application.Match(arr(i, 2), [{15,24,40}]) - 1
    
16.                arr(i, 4) = Split(d1(arr(i, 1)), "-")(k)
    
17.             Else
    
18.                k = Application.Match(arr(i, 2), [{15,24,40}]) - 1
    
19.                arr(i, 4) = Split(d2(arr(i, 1)), "-")(k)
    
20.             End If
    
21.          Next i
    
22.   Range("a3").Resize(i - 1, 4) = arr
    
23. End Sub
    

复制代码

moming0211

云影 发表于 2014-5-15 14:32

太感谢了。结果是我需要的，还要花点时间去消化你的程序。再次谢谢！

moming0211

grf1973 发表于 2014-5-15 13:36
需要更多的说明
1、是否PD、PY。。。。各出一张表
2、D列的数字是怎么出来的

谢谢，一直在百度上找相关案例，没有及时回复您，现在问题解决了。谢谢。