[已解决]一周---四周的编号和型号的统计

dabei321

之前发过一个类是的http://www.excelpx.com/forum.php?mod=viewthread&tid=339072&page=1#pid3835753是统计两个表的，如果统计的多的话就会公式很长，运算也会慢，所以前来寻求VBA解决
附件如下：
去重复值.rar (3.29 KB, 下载次数: 3)

2015-2-13 12:09 上传

点击文件名下载附件 [em22]

最佳答案

月排行榜 / 总排行榜

dsmch

2015-2-13 12:49

………………

跳转到最佳答案楼层

dsmch

………………

dabei321

一直在测试，不知道为什么在增加一个工作表后总提示错误

dabei321

20150214.rar (9.65 KB, 下载次数: 5)

2015-2-14 08:42 上传

点击文件名下载附件
您给看看是哪里出错了，总要让调试，我乱调了也没效果
注：Sheet1表中数据与其它表无关，不参加汇总

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, j%, s&, zf$
   
3. Set d = CreateObject("scripting.dictionary")
   
4. ReDim brr(1 To 20000, 1 To 2)
   
5. For j = 2 To Sheets.Count
   
6.     If Sheets(j).Name <> "月汇总" Then
   
7.         arr = Sheets(j).Range("b4").CurrentRegion
   
8.         For i = 2 To UBound(arr)
   
9.             zf = arr(i, 1) & "," & arr(i, 3)
   
10.             If Not d.exists(zf) Then
    
11.                 s = s + 1
    
12.                 d(zf) = ""
    
13.                 brr(s, 1) = arr(i, 1)
    
14.                 brr(s, 2) = arr(i, 3)
    
15.             End If
    
16.         Next
    
17.     End If
    
18. Next
    
19. [b5:c20000] = ""
    
20. Range("b5").Resize(s, 2) = brr
    
21. [b4].CurrentRegion.Sort Key1:=[b5], Key2:=[c5], Header:=xlGuess
    
22. End Sub

复制代码

dabei321

老师你看就是这个文件，其他的我都用最笨的做了，就是在汇总表中选前两项出问题，超出我的能力了，有些函数用的可能见笑了，请帮助看下吧

新一

工作表受保护了？{:04:}