VBA求助，计算排列后，从000-999集合中返回没有出过的数字排列

xiashuming1

VBA求助：计算单元格中的数字排列后，从000-999集合中返回没有出过的数字排列VBA逻辑：如图所示
  

  

  

  

ynzsvt

参与一下还得凑长度

micch

总共7行数据，得出7列结果+P列的结果，P列是前7列都没有的？这个好像遍历就行，反正才1000个

quqiyuan

循环遍历一遍，仅供参考，，，，

quqiyuan

代码如下。。。
Sub Demo()
    Dim wb As Workbook, sht As Worksheet
    Set wb = ThisWorkbook
    With wb.Sheets("sheet1")
        arr = .Range(.[b2], .Cells(.Rows.Count, 4).End(3))
        m = 0
        ReDim brr(1 To 100000, 1 To 1000)
        For i = 1 To UBound(arr)
            n = 0: m = m + 1
            For j = 1 To Len(arr(i, 1))
                s = Mid(arr(i, 1), j, 1)
                For k = 1 To Len(arr(i, 2))
                    ss = Mid(arr(i, 2), k, 1)
                    For l = 1 To Len(arr(i, 3))
                        sss = Mid(arr(i, 3), l, 1)
                        n = n + 1
                        brr(n, m) = "'" & s & ss & sss
                        x = Application.Max(x, n)
                    Next
                Next
            Next
        Next
        .[f2].Resize(x, m) = brr
        Beep
    End With
End Sub

飞天篮球猪

插件解法...仅供参考

micch

1. Sub Main()
   
2.     With Sheet1
   
3.         .Range("F:P").ClearContents
   
4.         ReDim res(0 To 999)
   
5.         r = 2: c = 6
   
6.         While .Cells(r, 2).Value <> ""
   
7.             ar = .Range("B" & r & ":D" & r).Value
   
8.             ReDim br(1 To 1000, 1 To 1)
   
9.             n = 0
   
10.             For i = 1 To Len(ar(1, 1))
    
11.             For j = 1 To Len(ar(1, 2))
    
12.             For k = 1 To Len(ar(1, 3))
    
13.                 n = n + 1
    
14.                 br(n, 1) = Mid(ar(1, 1), i, 1) & Mid(ar(1, 2), j, 1) & Mid(ar(1, 3), k, 1)
    
15.                 res(Val(br(n, 1))) = 1
    
16.             Next
    
17.             Next
    
18.             Next
    
19.             .Cells(2, c).Resize(n).Value = br
    
20.             c = c + 1
    
21.             r = r + 1
    
22.         Wend
    
23.         r = 2
    
24.         For i = 0 To 999
    
25.             If res(i) <> 1 Then .Cells(r, "P").Value = Format(i, "000"): r = r + 1
    
26.         Next
    
27.     End With
    
28. End Sub

复制代码

xiashuming1

quqiyuan 发表于 2025-1-11 15:29
循环遍历一遍，仅供参考，，，，

还差最后一步，没有出现的排列呢

xiashuming1

飞天篮球猪 发表于 2025-1-11 15:30
插件解法...仅供参考

这个用是什么处理方式呀

micch

代码审核，换个函数方式https://club.excelhome.net/forum ... 22&pid=11654274