求a1里数据1-33数字出现次数

王拥军

求a1里数据1-33数字出现次数.rar (97.73 KB, 下载次数: 26)

2018-7-29 17:47 上传

点击文件名下载附件

duquancai

这已超出学习范畴了吧！！！

一把小刀闯天下

'猜一个，输出[e11]

Option Explicit

Sub test()
  Dim arr, i, j, t
  With Sheets("sheet3")
    arr = .[b1].CurrentRegion
    ReDim brr(1 To 2, 1 To 33) As Long
    For i = 1 To UBound(brr, 2): brr(1, i) = i: Next
    For i = 2 To UBound(arr, 1)
      t = Split(arr(i, 1), ",")
      For j = 0 To UBound(t)
        brr(2, t(j)) = brr(2, t(j)) + 1
    Next j, i
    For i = 1 To UBound(brr, 2) - 1
      For j = i + 1 To UBound(brr, 2)
        If brr(2, i) < brr(2, j) Then
          t = brr(1, i): brr(1, i) = brr(1, j): brr(1, j) = t
          t = brr(2, i): brr(2, i) = brr(2, j): brr(2, j) = t
        End If
    Next j, i
    .[e11].Resize(UBound(brr, 1), UBound(brr, 2)) = brr
  End With
End Sub

chaohuahch

代码如下：供测试。

duquancai

chaohuahch 发表于 2018-7-29 22:29
代码如下：供测试。

好像与楼主模拟的有点区别，是不是我看错了。

719404338

Sub t()
Dim arr, brr(1 To 33), i%, t%
For i = 2 To 1074
arr = Split(Range("b" & i), ",")
For t = 0 To 5
brr(arr(t)) = brr(arr(t)) + 1
Next t
Next i
Range("e11").Resize(1, 33) = brr
End Sub

王拥军

请各位高手做附件里,谢谢

719404338

朋友 ，看看。

duquancai

玩赌的 楼主 挣了钱 分一点哈！！！

1. Sub main()
   
2.     Dim a, b(1 To 3, 1 To 33), js As Object, Dic As Object, t, s$
   
3.     Sheets("Sheet3").Select
   
4.     a = Range("b2:b" & Cells(Rows.Count, 2).End(3).Row)
   
5.     Set Dic = CreateObject("Scripting.Dictionary")
   
6.     Set js = CreateObject("MSScriptControl.ScriptControl")
   
7.     js.Language = "JavaScript": js.AddObject "d", Dic
   
8.     For i = 1 To 33: Dic(Format(i, "00")) = 0: Next
   
9.     For i = 1 To UBound(a): s = s & "," & a(i, 1): Next
   
10.     js.eval ("'" & s & "'.replace(/[^,]+/g,function(s){if(d.exists(s))d(s)+=1;});")
    
11.     t = Dic.items: s = Empty
    
12.     For i = 0 To 32: s = s & ",[" & t(i) & "," & i + 1 & "]": Next
    
13.     js.eval ("a=" & "[" & Mid(s, 2) & "]" & ";a.sort(function(x,y){return x[0]==y[0]?y[1]-x[1]:y[0]-x[0]});")
    
14.     For i = 0 To 32
    
15.         b(1, i + 1) = i + 1: b(2, i + 1) = t(i)
    
16.         b(3, i + 1) = js.eval("a[" & i & "][1]")
    
17.     Next
    
18.     Range("e7:ak9").ClearContents
    
19.     Range("e7:ak9") = b
    
20. End Sub

复制代码