EXCEL数组问题：提取重复次数最多的数字组合

xingjina500

LIUZHU 发表于 2023-1-28 15:37
你在买码吗？

谢谢参与！

xingjina500

我想达到下面的效果，就是在指定数据行内，求在各行中出现重复组合号码最多次的组合，有点绕口，还是看图吧。
再次感谢各位大神的帮助。

wodewan

xingjina500 发表于 2023-1-29 09:25
我想达到下面的效果，就是在指定数据行内，求在各行中出现重复组合号码最多次的组合，有点绕口，还是看图吧 ...

smiletwo

xingjina500 发表于 2023-1-29 08:20
谢谢参与。
码就是号码的意思

换个问法，2码、3码、4码是指什么呢

wang-way

1. Sub try()
   
2.     Dim arr, i, j, k, m, n, t
   
3.     Dim d As Object
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     arr = Range("c4:h8").Value
   
6.     For i = 1 To UBound(arr)
   
7.         For j = 1 To UBound(arr, 2) - 1
   
8.             For k = j + 1 To UBound(arr, 2)
   
9.                 d(arr(i, j) & "," & arr(i, k)) = d(arr(i, j) & "," & arr(i, k)) + 1
   
10.             Next k
    
11.         Next j
    
12.         For j = 1 To UBound(arr, 2) - 2
    
13.             For k = j + 1 To UBound(arr, 2) - 1
    
14.                 For m = k + 1 To UBound(arr, 2)
    
15.                     d(arr(i, j) & "," & arr(i, k) & "," & arr(i, m)) = d(arr(i, j) & "," & arr(i, k) & "," & arr(i, m)) + 1
    
16.                 Next m
    
17.             Next k
    
18.         Next j
    
19.         For j = 1 To UBound(arr, 2) - 3
    
20.             For k = j + 1 To UBound(arr, 2) - 3
    
21.                 For m = k + 1 To UBound(arr, 2) - 1
    
22.                     For n = m + 1 To UBound(arr, 2)
    
23.                         d(arr(i, j) & "," & arr(i, k) & "," & arr(i, m) & "," & arr(i, n)) = d(arr(i, j) & "," & arr(i, k) & "," & arr(i, m) & "," & arr(i, n)) + 1
    
24.                     Next n
    
25.                 Next m
    
26.             Next k
    
27.         Next j
    
28.     Next i
    
29.     t = d.items
    
30.     mx = WorksheetFunction.Max(t)
    
31.     For X = 1 To 3 '几个号码组合
    
32.         s = ""
    
33.         For i = mx To 1 Step -1
    
34.             For Each k In d
    
35.                 If Len(k) = Len(Replace(k, ",", "")) + X And d(k) = i Then
    
36.                     s = s & "|" & k
    
37.                 End If
    
38.             Next k
    
39.             If s <> "" Then
    
40.                 [l8].Offset(X - 1) = Mid(s, 2)
    
41.                 [m8].Offset(X - 1) = i
    
42.                 Exit For
    
43.             End If
    
44.         Next i
    
45.     Next X
    
46. End Sub

复制代码

xingjina500

wodewan 发表于 2023-1-29 10:44

先送上感谢！
我回去研究下。

xingjina500

wang-way 发表于 2023-1-29 21:52

谢谢，我要好好研究下。

xingjina500

smiletwo 发表于 2023-1-29 10:52
换个问法，2码、3码、4码是指什么呢

想偷懒，少打一个“号”字，2码就是2个号码……

xingjina500

wodewan 发表于 2023-1-29 10:44

没有算错，6，7组合是两个号码组合出现次数最多的。