如何统计同行中出现次数最多的三个数字

殷悦翔

这是一个大佬给的 统计同行出现次数最多的两个数。  我是小白 不知道统计同行出现3个数的咋弄 求助大佬

Sub 按钮1_Click()
    Dim sht As Worksheet
    Dim vData
    Dim dicA As New Dictionary
    Dim dicB As New Dictionary

    Set sht = Worksheets(1)
    vData = sht.Range("A1").CurrentRegion

    A = IIf(UBound(vData) - 50 < 0, 1, UBound(vData) - 49)

    For U = A To UBound(vData)
        For V = 1 To UBound(vData, 2) - 1
            For W = V + 1 To UBound(vData, 2)
                dicA(vData(U, V) & "," & vData(U, W)) = dicA(vData(U, V) & "," & vData(U, W)) + 1
            Next
        Next
    Next

    While dicA.Count
        dicB(dicA.Items(0)) = dicB(dicA.Items(0)) & dicA.Keys(0) & " "
        dicA.Remove dicA.Keys(0)
    Wend

    sht.Range("V1").CurrentRegion.ClearContents
    For A = 1 To 3
        V = WorksheetFunction.Max(dicB.Keys())
        sht.Range("V1").Offset(A - 1) = V
        sht.Range("W1").Offset(A - 1).Resize(1, UBound(Split(dicB(V))) + 1) = Split(dicB(V))
        dicB.Remove V
    Next
End Sub

清风竹-

请看附件。

LIUZHU

举一个具体的例子，否则看不懂需求

grf1973

1. Sub 按钮1_Click()
   
2.     Dim sht As Worksheet
   
3.     Dim vData
   
4.     Set dicA = CreateObject("scripting.dictionary")
   
5.     Set dicB = CreateObject("scripting.dictionary")
   
6. 
   
7.     Set sht = Worksheets(1)
   
8.     vData = sht.Range("A1").CurrentRegion
   
9. 
   
10.     A = IIf(UBound(vData) - 50 < 0, 1, UBound(vData) - 49)
    
11.     For U = A To UBound(vData)
    
12.         For v = 1 To UBound(vData, 2) - 2
    
13.             If Len(vData(U, v)) = 0 Then Exit For
    
14.             For w = v + 1 To UBound(vData, 2) - 1
    
15.                 If Len(vData(U, w)) = 0 Then Exit For
    
16.                 For x = w + 1 To UBound(vData, 2)
    
17.                     If Len(vData(U, x)) = 0 Then Exit For
    
18.                     s = vData(U, v) & "," & vData(U, w) & "," & vData(U, x)
    
19.                     dicA(s) = dicA(s) + 1
    
20.                 Next
    
21.             Next
    
22.         Next
    
23.     Next
    
24. 
    
25.     For Each x In dicA.keys
    
26.         dicB(dicA(x)) = dicB(dicA(x)) & x & "/"
    
27.     Next
    
28. 
    
29.     sht.Range("V1").CurrentRegion.ClearContents
    
30.     For A = 1 To 3
    
31.         v = WorksheetFunction.Max(dicB.keys())
    
32.         sht.Range("V1").Offset(A - 1) = v
    
33.         xrr = Split(dicB(v), "/")
    
34.         sht.Range("W1").Offset(A - 1).Resize(1, UBound(xrr)) = xrr
    
35.         dicB.Remove v
    
36.     Next
    
37. End Sub

复制代码

grf1973

2楼的代码有点小问题。如果最多、次多、第三多次数不连续的话（比如最多、次多、第三多为6次，4次，2次）的话，得不出正确结果。

grf1973

2楼代码修改如下：

1. Sub 统计数()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set d1 = CreateObject("scripting.dictionary")
   
4.     arr = Sheet1.Range("A1").CurrentRegion
   
5.     a = IIf(UBound(arr) - 50 < 0, 1, UBound(arr) - 49)
   
6.     For i = a To UBound(arr)
   
7.         For j = 1 To UBound(arr, 2) - 2
   
8.             For j2 = j + 1 To UBound(arr, 2) - 1
   
9.                 For j3 = j2 + 1 To UBound(arr, 2)
   
10.                 ss = arr(i, j) & "," & arr(i, j2) & "," & arr(i, j3)
    
11.                 If arr(i, j) <> "" And arr(i, j2) <> "" And arr(i, j3) <> "" Then
    
12.                     d(ss) = d(ss) + 1
    
13.                 End If
    
14.                 Next
    
15.             Next
    
16.         Next
    
17.     Next
    
18.     k = d.keys
    
19.     t = d.items
    
20.     For Each n In t: d1(n) = 1: Next   '次数去重
    
21.     x = Application.Max(t)   '最多
    
22.     y = Application.WorksheetFunction.Large(d1.keys, 2)  '次多
    
23.     Z = Application.WorksheetFunction.Large(d1.keys, 3)  '三多
    
24.    
    
25.     ReDim brr(1 To d.Count, 1 To 3)
    
26.     n1 = 1: n2 = 1: n3 = 1
    
27.     For i = 0 To UBound(t)
    
28.         If t(i) = x Then
    
29.             n1 = n1 + 1
    
30.             brr(n1, 1) = k(i)
    
31.         End If
    
32.         If t(i) = y Then
    
33.             n2 = n2 + 1
    
34.             brr(n2, 2) = k(i)
    
35.         End If
    
36.         If t(i) = Z Then
    
37.             n3 = n3 + 1
    
38.             brr(n3, 3) = k(i)
    
39.         End If
    
40.     Next
    
41.     brr(1, 1) = "出现" & x & "次，共" & n1 - 1 & "组": brr(1, 2) = "出现" & x - 1 & "次，共" & n2 - 1 & "组": brr(1, 3) = "出现" & x - 2 & "次，共" & n3 - 1 & "组"
    
42.     Columns("X:Z").ClearContents
    
43.     [x1].Resize(n3, 3) = brr
    
44. End Sub

复制代码

grf1973

用wps做了一个，稍微简洁点。

Again123456

看不懂什么叫“一对”，还有“50行数据中在同一行出现次数最多的三个数” 是COUNTIF($A$11:$T$60,A11)？。只会写一行代码，let arr =Range("a1").CurrentRegion.Value2.slice(-50)

wanghan519

不知理解的对不对，不过可以试一下金山文档的py脚本

一步001

试着写一个，看看能用吗