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

quqiyuan

xiashuming1 发表于 2025-1-11 15:39
还差最后一步，没有出现的排列呢

哦恩，没注意最好的要求，现在增加一下。。。

quqiyuan

代码如下。。。。
Sub Demo()
    Dim wb As Workbook, sht As Worksheet
    Set wb = ThisWorkbook
    Set d = CreateObject("scripting.dictionary")
    For i = 0 To 999
        s = "'" & Format(i, "000")
        d(s) = ""
    Next
    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
                        If d.exists(brr(n, m)) Then d.Remove brr(n, m)
                        x = Application.Max(x, n)
                    Next
                Next
            Next
        Next
        .[f2].Resize(x, m) = brr
        .[p2].Resize(d.Count) = Application.Transpose(d.keys)
    End With
    Set d = Nothing
    Beep
End Sub

xiashuming1

micch 发表于 2025-1-11 15:50
代码审核，换个函数方式https://club.excelhome.net/forum.php?mod=redirect&goto=findpost&ptid=1647322&p ...

你好，我用公式计算值就出现错误了，要不请直接发一下Excel的压缩文档，非常感谢！

xiashuming1

quqiyuan 发表于 2025-1-11 15:57
哦恩，没注意最好的要求，现在增加一下。。。

谢谢，收到，非常强大

xiashuming1

quqiyuan 发表于 2025-1-11 15:58
代码如下。。。。
Sub Demo()
    Dim wb As Workbook, sht As Worksheet

gwjkkkkk

gwjkkkkk

参与一下。。。

micch

xiashuming1 发表于 2025-1-11 16:06
你好，我用公式计算值就出现错误了，要不请直接发一下Excel的压缩文档，非常感谢！

应该是不支持365函数

xiashuming1

gwjkkkkk 发表于 2025-1-11 16:49
参与一下。。。

速度非常快，优秀产品，今天没有小花送了，明天补

一招秒杀

简单就是美，1句5行，瞬间秒杀。