统计数字出现次数vba怎么写？

ssqyc

统计数字出现次数vba怎么写？
000.rar (19.75 KB, 下载次数: 41)

2017-4-28 22:17 上传

点击文件名下载附件

maditate

语文水平不够，等我找语文老师补补课以后再来看楼的主要求。

小花鹿

Sub test()
Dim s, i&, n&, n1&
For i = 1 To 95
    s = s & Cells(i, 1)
Next i
n = Len(s)
n1 = Len(Replace(s, "0", ""))
MsgBox n - n1
End Sub

未忘初心

1. Sub test()
   
2.     Dim arr, arr2
   
3.     arr = Range("A1").CurrentRegion.Value
   
4.     arr2 = Range("L3:AE12").Value
   
5.     For iCol = 1 To UBound(arr2, 2) Step 2
   
6.         For iRow = 1 To UBound(arr2)
   
7.             iTemp = arr2(iRow, iCol)
   
8.             If Len(iTemp) > 0 Then
   
9.                  For iRow2 = 1 To UBound(arr)
   
10.                     iTemp2 = arr(iRow2, (iCol + 1) / 2)
    
11.                     For l = 1 To Len(iTemp2)
    
12.                         If iTemp = Mid(iTemp2, l, 1) + 0 Then
    
13.                             arr2(iRow, iCol + 1) = arr2(iRow, iCol + 1) + 1
    
14.                         End If
    
15.                     Next
    
16.                  Next
    
17.             End If
    
18.         Next
    
19.     Next
    
20.     Range("L3:AE12").Value = arr2
    
21. End Sub

复制代码

未忘初心

参考学习 O(∩_∩)O

ssqyc

未忘初心 发表于 2017-4-28 23:50
参考学习 O(∩_∩)O

老师你好是这样的
第一列号码3统计数的是最多35次，6出现34次。。。。1出现最少19次，出现次数由大到小排列如下
3        35
6        34
7        33
9        31
0        31
8        29
2        26
5        24
4        23
1        19
10列的数都是这样统计的，请老师更改一下程序，谢谢老师
还有每次统计后把原来的统计数都删掉。

zax010

Sub zz()
    Dim d, ar
    Application.ScreenUpdating = False
    Set d = CreateObject("Scripting.Dictionary")
    ar = Range("A1:J" & [a65536].End(3).Row)
    For j = 1 To UBound(ar, 2)
        For i = 1 To UBound(ar)
            s = s & ar(i, j)
        Next
        For x = 1 To Len(s)
            d(Mid(s, x, 1)) = d(Mid(s, x, 1)) + 1
        Next
        With Cells(3, 12 + n).Resize(d.Count, 2)
            .Value = Application.Transpose(Array(d.keys, d.items))
            .Sort Cells(3, 12 + n + 1), xlDescending, Header:=xlGuess
        End With
        s = "": n = n + 2: d.RemoveAll
    Next
    Application.ScreenUpdating = True
End Sub

zax010

没看见你的程序。


000.rar (25.67 KB, 下载次数: 41)

2017-4-29 09:42 上传

点击文件名下载附件

八月十五

1. Dim kr, icount%
   
2. 
   
3. Sub GetData()
   
4.     Dim ar, i%, str$
   
5.     [l3:ae65536].Clear
   
6.     ar = Cells(1, 1).CurrentRegion
   
7.     ReDim kr(1 To 10, 1 To UBound(ar, 2) * 2)
   
8.     For i = 1 To UBound(ar, 2)
   
9.         str = Join(Application.Transpose(Application.Index(ar, , i)))
   
10.         icount = icount + 2: Call NumberCount(str, icount)
    
11.     Next
    
12.     Call iSort(kr)
    
13.     [l3].Resize(10, icount) = kr
    
14.     Erase kr: icount = 0
    
15. End Sub
    
16. Sub NumberCount(str, icount)
    
17.     Dim i%
    
18.     With CreateObject("vbscript.regexp")
    
19.         For i = 0 To 9
    
20.             .Pattern = "" & i & ""
    
21.             .Global = True
    
22.             kr(i + 1, icount - 1) = i: kr(i + 1, icount) = .Execute(str).Count
    
23.         Next
    
24.     End With
    
25. End Sub
    
26. Sub iSort(kr)
    
27.     Dim i&, j&, k%, t1, t2
    
28.     For k = 2 To UBound(kr, 2) Step 2
    
29.         For i = UBound(kr) To 2 Step -1
    
30.             For j = 1 To i - 1
    
31.                 If kr(j, k) < kr(j + 1, k) Then
    
32.                     t1 = kr(j, k): kr(j, k) = kr(j + 1, k): kr(j + 1, k) = t1
    
33.                     t2 = kr(j, k - 1): kr(j, k - 1) = kr(j + 1, k - 1): kr(j + 1, k - 1) = t2
    
34.                 End If
    
35.             Next
    
36.         Next
    
37.     Next
    
38. End Sub
    

复制代码