请大神帮忙，数据汇总统计，谢谢！

liulang0808

1. Sub 按钮1_Click()
   
2.     arr = Sheets(1).UsedRange
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set dt = CreateObject("scripting.dictionary")
   
5.     Set dd = CreateObject("scripting.dictionary")
   
6.     Set dg = CreateObject("scripting.dictionary")
   
7.     Sheets(2).Select
   
8.     ActiveSheet.UsedRange.Offset(1).ClearContents
   
9.     brr = [a1].Resize(UBound(arr), 6)
   
10.     Application.ScreenUpdating = False
    
11.     a = 2
    
12.     For j = UBound(arr) To 2 Step -1
    
13.         If Len(arr(j, 16)) > 3 Then
    
14.             If Mid(arr(j, 16), 2, 2) * 1 > 20 Then
    
15.                 str1 = "虚拟出货"
    
16.             Else
    
17.                 str1 = Mid(arr(j, 16), 2, 2)
    
18.             End If
    
19.             If str1 <> "虚拟出货" Then dt(arr(j, 3)) = dt(arr(j, 3)) + arr(j, 14)
    
20.             dg(arr(j, 3) & "#" & str1) = dg(arr(j, 3) & "#" & str1) + 1
    
21.             If d.exists(arr(j, 3) & "#" & str1) Then
    
22.                 r = d(arr(j, 3) & "#" & str1)
    
23.                 brr(r, 3) = arr(j, 14) + brr(r, 3)
    
24.                 If InStr(dd(arr(j, 3)), arr(j, 4)) = 0 Then
    
25.                     dd(arr(j, 3)) = dd(arr(j, 3)) & arr(j, 4) & ","
    
26.                 End If
    
27.             Else
    
28.                 d(arr(j, 3) & "#" & str1) = a
    
29.                 brr(a, 1) = arr(j, 3)
    
30.                 brr(a, 2) = str1
    
31.                 brr(a, 3) = arr(j, 14)
    
32.                 If InStr(dd(arr(j, 3)), arr(j, 4)) = 0 Then
    
33.                     dd(arr(j, 3)) = dd(arr(j, 3)) & arr(j, 4) & ","
    
34.                 End If
    
35. 
    
36.                 a = a + 1
    
37.             End If
    
38.         End If
    
39.     Next j
    
40.     For j = 2 To a - 1
    
41.         brr(j, 6) = dg(brr(j, 1) & "#" & brr(j, 2))
    
42.         If brr(j, 2) <> "虚拟出货" Then
    
43.             If dt.exists(brr(j, 1)) Then
    
44.                 brr(j, 4) = UBound(Split(dd(brr(j, 1)), ","))
    
45.                 brr(j, 5) = dt(brr(j, 1))
    
46.                 dt.Remove brr(j, 1)
    
47.                 dd.Remove brr(j, 1)
    
48.             End If
    
49.         End If
    
50.     Next j
    
51.     [a1].Resize(a - 1, 6) = brr
    
52.     Application.ScreenUpdating = True
    
53. End Sub
    

复制代码

liulang0808

在f列增加了，供参考。。。