[已解决]在线的老师看看，怎样用VBA单独统计重复数据的次数

manz

在线的老师看看，怎样用VBA单独统计重复数据的次数

最佳答案

月排行榜 / 总排行榜

grf1973

2014-10-13 10:09

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Sheet1.[a1].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         x = arr(i, 1) & arr(i, 7)   '名称+买卖盘性质
   
6.         d(x) = d(x) + 1
   
7.     Next
   
8.     brr = [a1].CurrentRegion
   
9.     For i = 2 To UBound(brr)
   
10.         x1 = brr(i, 2) & "买盘"
    
11.         x2 = brr(i, 2) & "卖盘"
    
12.         x3 = brr(i, 2) & "中性盘"
    
13.         brr(i, 10) = d(x1)
    
14.         brr(i, 11) = d(x2)
    
15.         brr(i, 12) = d(x3)
    
16.     Next
    
17.     [J1].Resize(i - 1, 1) = Application.Index(brr, , 10)
    
18.     [K1].Resize(i - 1, 1) = Application.Index(brr, , 11)
    
19.     [L1].Resize(i - 1, 1) = Application.Index(brr, , 12)
    
20. End Sub
    

复制代码

跳转到最佳答案楼层

su45

为什么第一行与第二行的公式不一样：
=COUNTIFS(Sheet1!$A$1:$A$49995,Sheet2!$B2,Sheet1!$G$1:$G$49995,Sheet2!C$1)

=COUNTIFS(Sheet1!$A$1:$A$49995,Sheet3!$B3,Sheet1!$G$1:$G$49995,Sheet3!C$1)

dsmch

建议全部用vba解决，发个03版本（用兼容包转换后公式结果错误）

grf1973

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Sheet1.[a1].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         x = arr(i, 1) & arr(i, 7)   '名称+买卖盘性质
   
6.         d(x) = d(x) + 1
   
7.     Next
   
8.     brr = [a1].CurrentRegion
   
9.     For i = 2 To UBound(brr)
   
10.         x1 = brr(i, 2) & "买盘"
    
11.         x2 = brr(i, 2) & "卖盘"
    
12.         x3 = brr(i, 2) & "中性盘"
    
13.         brr(i, 10) = d(x1)
    
14.         brr(i, 11) = d(x2)
    
15.         brr(i, 12) = d(x3)
    
16.     Next
    
17.     [J1].Resize(i - 1, 1) = Application.Index(brr, , 10)
    
18.     [K1].Resize(i - 1, 1) = Application.Index(brr, , 11)
    
19.     [L1].Resize(i - 1, 1) = Application.Index(brr, , 12)
    
20. End Sub
    

复制代码

grf1973

请看附件。

manz

su45 发表于 2014-10-11 21:49
为什么第一行与第二行的公式不一样：
=COUNTIFS(Sheet1!$A$1:$A$49995,Sheet2!$B2,Sheet1!$G$1:$G$49995,S ...

su45老师，是我写错了，我对函数公式不是很懂，都是在一点一点的摸索着学习呢，这个错误我也发现了，已经改过来了，谢谢您的提醒和帮助。

manz

grf1973 发表于 2014-10-13 10:09

grf1973老师，衷心的谢谢您的指导，终于解决问题了，好开心！不过这几天我也想出来一个笨方法，也是通过论坛里的老师的提示想出来的，方法就是：当这个统计表用公式计算完成后，复制整个统计表，在粘贴，粘贴的时候在粘贴选项里选择“值”，这样，统计表就全部变成不含函数公式的数据了。就可以任意的排序了！唯一的遗憾就是，源数据刷新后，我就得重新复制公式，在计算，在复制数据，在粘贴，在排序，周而复始，可真够麻烦的了。另外，计算一次就需要40多分钟，有时候把我电脑都弄崩溃了，实在是想不出好办法来。最后，还要衷心的感谢您，我在这里给您鞠躬了！

grf1973

数据量大最好不要用公式，建议所有列都用VBA解决。

manz

grf1973 发表于 2014-10-14 10:00
数据量大最好不要用公式，建议所有列都用VBA解决。

grf1973老师，你能帮我把统计表修改成用VBA来统计吗？

grf1973

下面是B列到L列的代码，可以看一下。

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set d1 = CreateObject("scripting.dictionary")
   
4.     arr = Sheet1.[a1].CurrentRegion
   
5.     For i = 2 To UBound(arr)
   
6.         x = arr(i, 1) & arr(i, 7)   '名称+买卖盘性质
   
7.         d(x) = d(x) + 1
   
8.         d1(x) = d1(x) + arr(i, 5)
   
9.     Next
   
10.     brr = [a1].CurrentRegion
    
11.     ReDim bbrr(1 To UBound(brr) - 1, 1 To 10)
    
12.     For i = 2 To UBound(brr)
    
13.         x1 = brr(i, 2) & "买盘"
    
14.         x2 = brr(i, 2) & "卖盘"
    
15.         x3 = brr(i, 2) & "中性盘"
    
16.         p = i - 1
    
17.         bbrr(p, 1) = d1(x1): bbrr(p, 8) = d(x1)       '买盘数/重复数
    
18.         bbrr(p, 2) = d1(x2): bbrr(p, 9) = d(x2)       '卖盘数/重复数
    
19.         bbrr(p, 3) = d1(x3): bbrr(p, 10) = d(x3)       '中性盘数/重复数
    
20.         s = bbrr(p, 1) + bbrr(p, 2) + bbrr(p, 3): bbrr(p, 4) = s         '总盘数
    
21.         If s > 0 Then
    
22.             bbrr(p, 5) = bbrr(p, 1) / s          '买占比
    
23.             bbrr(p, 6) = bbrr(p, 2) / s        '卖占比
    
24.             bbrr(p, 7) = bbrr(p, 3) / s       '中占比
    
25.         End If
    
26.     Next
    
27.     [C2].Resize(p, 10) = bbrr
    
28. End Sub
    

复制代码