5位数找4位数相同（不区分顺序）

阿龙老师

如下图，从0001开始，筛选出所有可能性的组合~

grf1973

数据量有点大，需要运行个5-6秒。

grf1973

有点小问题，5选4是5种可能。要改一下。

micch

1. Sub Main()
   
2.     Dim d As Object
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.    
   
5.     ar = [a2:a2325]
   
6.     For Each x In ar
   
7.         s = SortNum(Format(x, "00000"))
   
8.         For k = 1 To 5
   
9.             a = Left(s, k - 1) & Mid(s, k + 1)
   
10.             If Not d.exists(a) Then Set d(a) = CreateObject("scripting.dictionary")
    
11.             d(a)(x) = ""
    
12.         Next
    
13.     Next
    
14.     ReDim br(1 To UBound(ar) + 1, 1 To d.Count)
    
15.     For Each a In d.keys
    
16.         j = j + 1
    
17.         br(1, j) = a
    
18.         i = 1
    
19.         For Each x In d(a).keys
    
20.             i = i + 1
    
21.             br(i, j) = x
    
22.         Next
    
23.     Next
    
24.     [f5].Resize(UBound(br), UBound(br, 2)) = br
    
25.     Set d = Nothing
    
26.    
    
27. End Sub
    
28. Function SortNum(n)
    
29.     Dim ar(9) As String
    
30.     For i = 1 To Len(n)
    
31.         ar(Mid(n, i, 1)) = Mid(n, i, 1)
    
32.     Next
    
33.     SortNum = Join(ar, "")
    
34. End Function
    

复制代码

准提部林

micch 发表于 2023-1-18 20:47

五個數字會有重覆的 11223,99998
Function SortNum(n)
    Dim ar(9) As String,s%
    For i = 1 To Len(n)
         s=Mid(n, i, 1)
        ar(s) =ar(s) & s
    Next
    SortNum = Join(ar, "")
End Function

micch

难怪结果有3位数字的，忘了考虑重复数字了

LIUZHU

micch 发表于 2023-1-18 20:47

请教下，这个对于列举C(5,4)的所有组合可以这样写，如果列举C(6,4)的组合呢，该如何写代码？

grf1973

突然想到根本不用两两比较，直接可各种可能的四位数相对应的5位数用字典归类即可。
两两比较纯属多此一举。
字符串内数值排序用15楼的代码，速度有提高。

LIUZHU

从14楼的代码中学习到的，取组合列表，写的JS宏

LIUZHU

附件在此，WPS测试