求帮忙修改宏

liudaoyuan

求根据  B D 相同 合并C    结果返回  E F  G  

liudaoyuan

求大神们帮忙，急等。谢谢啦

gdw831001

求根据  B D 相同 合并C，这句话和楼主模拟结果不一样吧，应该是把b列相同合并计算，

liudaoyuan

B D 一样，求和C     后面按下执行，返回结果

liudaoyuan

顶起来，希望大神们帮忙解决

liudaoyuan

顶起来，希望大神们帮忙解决

uynayna

1. Sub test()
   
2.     Dim arr
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     With Sheet2
   
5.         .Columns("E:g").Clear
   
6.         arr = .[a1].CurrentRegion
   
7.     End With
   
8.     ReDim brr(1 To UBound(arr), 1 To 3)
   
9.     For i = 2 To UBound(arr)
   
10.         ss = arr(i, 2) & arr(i, 4)
    
11.             If Not d.exists(ss) Then
    
12.                n = n + 1
    
13.                d(ss) = n
    
14.                brr(n, 1) = arr(i, 2)
    
15.                brr(n, 3) = arr(i, 4)
    
16.                brr(n, 2) = arr(i, 3)
    
17.             Else
    
18.                brr(d(ss), 2) = brr(d(ss), 2) + arr(i, 3)
    
19.             End If
    
20.         d(arr(i, 2)) = d(arr(i, 2)) + arr(i, 2)
    
21.     Next
    
22.     Sheet2.[e1:f1:g1] = Array("产品编号", "数量", "港口")
    
23.     Range("e2").Resize(UBound(brr), 3) = brr
    
24. End Sub

复制代码

liudaoyuan

uynayna 发表于 2018-4-25 15:41

大神厉害，配合，跪谢跪谢

丢丢表格

liudaoyuan 发表于 2018-4-25 15:58
大神厉害，配合，跪谢跪谢

做个透视 不是很好吗 ？？

liudaoyuan

丢丢表格 发表于 2018-4-25 16:19
做个透视 不是很好吗 ？？

宏比较方便把，每次他们新的数据，只要这里复制进去 按下执行即可