[已解决]关于数字的出现的次数统计的VBA代码?

学习学习vba

附件下载:: 20141124.rar (2.94 KB, 下载次数: 20)

2014-11-24 22:18 上传

点击文件名下载附件

问题如下:
要统计的数据在B列..

附件里的help.xls
B列有24组数据

01-11 11个数字,每个次数出现的次数为:
                01        02        03        04        05        06        07        08        09        10        11
出现次数        5        10        14        12        11        11        9        13        11        14        10

出现次数多的排在前面 得到结果为:

                 03        10        08        04        05        06        09        02        11        07        01
出现次数        14        14        13        12        11        11        11        10        10        9        5


最后
03        10        08        04        05        06        09        02        11        07        01
就是要得到的结果,结果依次写到D23:N23

最佳答案

月排行榜 / 总排行榜

dsmch

2014-11-25 08:36

Sub Macro1()
Dim arr, d, i&, j%
Set d = CreateObject("scripting.dictionary")
arr = Range("b1").CurrentRegion
For i = 1 To 11
    d("'" & Format(i, "00")) = 0
Next
For i = 1 To UBound(arr)
    x = Split(arr(i, 1))
    For j = 0 To UBound(x)
        d("'" & x(j)) = d("'" & x(j)) + 1
    Next
Next
[d23:n23] = d.keys
[d24:n24] = d.items
[D23:N24].Sort [d24], Order1:=xlDescending, Header:=xlGuess, Orientation:=xlLeftToRight
[d24:n24] = ""
End Sub

跳转到最佳答案楼层

as0810114

数组公式，右拉

1. =RIGHT(LARGE(COUNTIF($B1:$B24,"*"&RIGHT(0&ROW(1:11),2)&"*")/1%%-ROW(1:11)/1%+ROW(1:11),COLUMN(A1)),2)

复制代码

dsmch

1. Sub Macro1()
   
2. Dim arr, d, i&, j%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("b1").CurrentRegion
   
5. For i = 1 To 11
   
6.     d("'" & Format(i, "00")) = 0
   
7. Next
   
8. For i = 1 To UBound(arr)
   
9.     x = Split(arr(i, 1))
   
10.     For j = 0 To UBound(x)
    
11.         d("'" & x(j)) = d("'" & x(j)) + 1
    
12.     Next
    
13. Next
    
14. [d23:n23] = d.keys
    
15. [d24:n24] = d.items
    
16. [D23:N24].Sort [d24], Order1:=xlDescending, Header:=xlGuess
    
17. [d24:n24] = ""
    
18. End Sub
    

复制代码

学习学习vba

dsmch 发表于 2014-11-25 05:17

老师好...

测试 了代码 ,运算结果不对.

01

02

03

04

05

06

07

08

09

10

11

dsmch

Sub Macro1()
Dim arr, d, i&, j%
Set d = CreateObject("scripting.dictionary")
arr = Range("b1").CurrentRegion
For i = 1 To 11
    d("'" & Format(i, "00")) = 0
Next
For i = 1 To UBound(arr)
    x = Split(arr(i, 1))
    For j = 0 To UBound(x)
        d("'" & x(j)) = d("'" & x(j)) + 1
    Next
Next
[d23:n23] = d.keys
[d24:n24] = d.items
[D23:N24].Sort [d24], Order1:=xlDescending, Header:=xlGuess, Orientation:=xlLeftToRight
[d24:n24] = ""
End Sub

学习学习vba

dsmch 发表于 2014-11-25 08:36
Sub Macro1()
Dim arr, d, i&, j%
Set d = CreateObject("scripting.dictionary")

要是  数据不止是24个...是不是改动 代码里 有24的地方就行???

一切随缘行不

英文不好，学习吃力