[已解决]求统计个数代码

youxinggy

求统计个数代码，请大侠帮忙，见附件

最佳答案

月排行榜 / 总排行榜

sunjing-zxl

2012-1-18 13:44

附件： 统计个数-sunjing.rar (11.04 KB, 下载次数: 17)

2012-1-18 13:44 上传

点击文件名下载附件

跳转到最佳答案楼层

lzclzch

楼主是不是这样的

youxinggy

lzclzch 发表于 2012-1-18 12:03
楼主是不是这样的

谢谢您的回复，结果见附件

sunjing-zxl

1. Sub aa()
   
2.     Dim arr, i As Long, j As Long
   
3.     Dim Co As Long, Ro As Long
   
4.     Dim arr1
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     Co = Range("C1").End(xlToRight).Column
   
7.     For i = 3 To Co
   
8.         Ro = IIf(Cells(65536, i).End(xlUp).Row > Ro, Cells(65536, i).End(xlUp).Row, Ro)
   
9.     Next i
   
10.     arr = Range(Cells(2, 3), Cells(Ro, Co))
    
11.     For i = 1 To UBound(arr)
    
12.         For j = 1 To UBound(arr, 2)
    
13.             If arr(i, j) <> "" Then
    
14.                 d(arr(i, j)) = d(arr(i, j)) + 1
    
15.             End If
    
16.         Next j
    
17.     Next i
    
18.     Range("A2:B" & [A65536].End(xlUp).Row + 1).ClearContents
    
19.     Range("A2").Resize(d.Count, 1) = Application.Transpose(d.Keys)
    
20.     Range("B2").Resize(d.Count, 1) = Application.Transpose(d.Items)
    
21. End Sub

复制代码

sunjing-zxl

附件： 统计个数-sunjing.rar (11.04 KB, 下载次数: 17)

2012-1-18 13:44 上传

点击文件名下载附件