麻烦的数据汇总，请帮助。每天都要这样处理，好麻烦

此用户被禁言

各位看一下，附件中的求助，每次处理好麻烦，都要手功去处理，希望能够VBA一次得到橙色数据的结果



麻烦的汇总.zip (59.91 KB, 下载次数: 20)

2016-1-14 17:01 上传

点击文件名下载附件

autumnalRain

这个可以通过SQL很方便解决，有时间测试下

bajifeng

商品个数的计算，以哪列作为识别依据？

chenbiao2012

1. Sub test()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     With Sheets("sheet1")
   
4.         arr = .[a1].CurrentRegion
   
5.         For i = 2 To UBound(arr)
   
6.             x = arr(i, 1) & arr(i, 2)
   
7.             If Not d.exists(x) Then
   
8.                 ReDim brr(1 To 3)
   
9.                 brr(1) = arr(i, 3)
   
10.                 brr(2) = arr(i, 5)
    
11.             Else
    
12.                 brr = d(x)
    
13.                 brr(1) = brr(1) + arr(i, 3)
    
14.                 brr(2) = brr(2) + arr(i, 5)
    
15.             End If
    
16.             d(x) = brr
    
17.         Next
    
18.         ReDim crr(1 To 5, 1 To 3)
    
19.         For Each k In d.keys
    
20.             t = d(k)
    
21.             a = t(2) / t(1)
    
22.             s = IIf(a > 10000, 5, IIf(a > 5000, 4, IIf(a > 3000, 3, IIf(a > 1000, 2, 1))))
    
23.             crr(s, 1) = crr(s, 1) + 1
    
24.             crr(s, 2) = crr(s, 2) + t(1)
    
25.             crr(s, 3) = crr(s, 3) + t(2)
    
26.         Next
    
27.         .[i16].Resize(5, 3).ClearContents
    
28.         .[i16].Resize(5, 3) = crr
    
29.     End With
    
30. End Sub
    

复制代码

hlly888

1. Sub yy() 'hlly888
   
2. Range("i2:k65536").ClearContents
   
3. Application.ScreenUpdating = False
   
4. Dim dc As Object, arr, brr(), i&, w, s&, a, c, crr(1 To 6, 1 To 5)
   
5. Set dc = CreateObject("scripting.dictionary")
   
6. arr = [a1].CurrentRegion
   
7. ReDim brr(1 To UBound(arr), 1 To 5)
   
8.    
   
9.     For i = 2 To UBound(arr)
   
10.         a = arr(i, 1) & arr(i, 2)
    
11.         w = dc(a)
    
12.         If w = "" Then
    
13.            s = s + 1: dc(a) = s
    
14.            brr(s, 1) = arr(i, 1)
    
15.            brr(s, 2) = arr(i, 2)
    
16.            brr(s, 3) = arr(i, 3)
    
17.            brr(s, 4) = arr(i, 5)
    
18.            brr(s, 5) = brr(s, 4) / brr(s, 3)
    
19.         Else
    
20.            brr(w, 3) = brr(w, 3) + arr(i, 3)
    
21.            brr(w, 4) = brr(w, 4) + arr(i, 5)
    
22.            brr(w, 5) = brr(w, 4) / brr(w, 3)
    
23.         End If
    
24.     Next
    
25.     For i = 1 To s
    
26.         If brr(i, 5) < 1000 Then c = 1
    
27.         If brr(i, 5) >= 1000 And brr(i, 5) < 3000 Then c = 2
    
28.         If brr(i, 5) >= 3000 And brr(i, 5) < 5000 Then c = 3
    
29.         If brr(i, 5) >= 5000 And brr(i, 5) < 10000 Then c = 4
    
30.         If brr(i, 5) >= 10000 Then c = 5
    
31.         crr(c, 1) = crr(c, 1) + 1: crr(c, 2) = crr(c, 2) + brr(i, 3): crr(c, 3) = crr(c, 3) + brr(i, 4)
    
32.         crr(6, 2) = crr(6, 2) + brr(i, 3): crr(6, 3) = crr(6, 3) + brr(i, 4)
    
33.     Next
    
34.     crr(6, 1) = s
    
35. 
    
36. [i2].Resize(6, 3) = crr
    
37. Application.ScreenUpdating = True
    
38. End Sub
    

复制代码

hlly888

麻烦的汇总.zip (124.57 KB, 下载次数: 14)

2016-1-14 18:29 上传

点击文件名下载附件

此用户被禁言

hlly888 发表于 2016-1-14 18:29

多谢，但是你的代码和chenbiao2012老师的有一点差异。同时和我删除重复后计算出来的也有差异不知道是哪里的问题了。

此用户被禁言

chenbiao2012 发表于 2016-1-14 18:06

多谢老师。但是和我删除重复后再统计。有差异。不知道是哪里问题了。如果是浮点精度的话。但是前面 三个的差距范围就太大了.

此用户被禁言

谢谢各位老师，是我弄错了，结果是正确的，我把单价放进去统计了。所以不正确了。现在把数量与金额放进去后就正确了。。谢谢。

yjh_27

统计区间由h16~h20确定