[已解决]统计A列内某个数字出现的次数

lovelfg

如附件所示，A列内有这样的一系列数字

Q3
101
102
101/102
103
101/102/103
104
109/1011/1012
106
101/102/103
106
1011/1012
102/108
101/107
107
106
106
105/1011/1012
107

现在B列内列出所有元素，要统计出每种数字出现的次数，附件内有我尝试写的代码，但可惜完全是错的，求教高人指点一下
Sub test()
Dim i, j, k
Dim arr, n
Do While Range("B" & j) <> ""
  For i = 2 To Range("A65535").End(xlUp).Row
   arr = Split(Range("A" & i))
    For Each n In arr
     If Val(n) = Range("B" & j) Then
      k = k + 1
     End If
    Next
   Range("C" & j) = k
   j = j + 1
   Next
Loop
End Sub

最佳答案

月排行榜 / 总排行榜

苏子龙

2017-8-17 16:30

1. Sub tt()
   
2. Dim i%, arr, brr, d, n%
   
3. arr = Range("a1").CurrentRegion
   
4. Set d = CreateObject("scripting.dictionary") '创建字典
   
5. For i = 2 To UBound(arr)
   
6.     brr = Split(arr(i, 1), "/") '数据放到brr
   
7.     For n = 0 To UBound(brr)
   
8.         If Not d.Exists(brr(n)) Then '用字典判断是否重复
   
9.             d(brr(n)) = Array(brr(n), 1)
   
10.         Else
    
11.             d(brr(n)) = Array(brr(n), d(brr(n))(1) + 1)
    
12.         End If
    
13. Next n, i
    
14. Range("b2").Resize(d.Count, 2) = Application.Transpose(Application.Transpose(d.items))
    
15. End Sub
    

复制代码

跳转到最佳答案楼层

苏子龙

1. Sub tt()
   
2. Dim i%, arr, brr, d, n%
   
3. arr = Range("a1").CurrentRegion
   
4. Set d = CreateObject("scripting.dictionary") '创建字典
   
5. For i = 2 To UBound(arr)
   
6.     brr = Split(arr(i, 1), "/") '数据放到brr
   
7.     For n = 0 To UBound(brr)
   
8.         If Not d.Exists(brr(n)) Then '用字典判断是否重复
   
9.             d(brr(n)) = Array(brr(n), 1)
   
10.         Else
    
11.             d(brr(n)) = Array(brr(n), d(brr(n))(1) + 1)
    
12.         End If
    
13. Next n, i
    
14. Range("b2").Resize(d.Count, 2) = Application.Transpose(Application.Transpose(d.items))
    
15. End Sub
    

复制代码

lovelfg

苏子龙 发表于 2017-8-17 16:30

目前字典我用的不好，我会好好参考您的代码来学习，非常感谢！

qdwfjmqj

你看行不行

lovelfg

qdwfjmqj 发表于 2017-8-17 17:40
你看行不行

可以的！万分感谢！