excel - VBA Excel：使用单个元素列表且没有元素重复的可行组合创建者

Question

我有以下 Excel 表，其中使用 A 列中的 3、2 和 1 组中的 2 到 50 的数字构建随机数组合。我正在尝试在 A 列元素之间构建整个可能的组合，以便获得的组合不会其中有任何重复的数字，并包含从 2 到 50 的所有数字。我当前的代码从 A2 开始，只构建一个组合集。它不会像 A2 中那样使用起始元素评估其他可能的组合，然后转到 A3，然后使用 A3 仅构建一个组合集。此步骤对 A4、A5 继续...

这是我当前的代码。

  Private Sub RP()

    Dim lRowCount As Long
    Dim temp As String, s As String
    Dim arrLength As Long
    Dim hasElement As Boolean
    Dim plans() As String, currentPlan() As String
    Dim locationCount As Long
    Dim currentRoutes As String
    Dim line As Long

    Worksheets("Sheet1").Activate
    Application.ActiveSheet.UsedRange
    lRowCount = ActiveSheet.UsedRange.Rows.Count
    locationCount = -1
    line = 2

    Debug.Print ("*********")

    For K = 2 To lRowCount - 1
        currentRoutes = ""
        For i = K To lRowCount
            s = ActiveSheet.Cells(i, 1)
            Do
                temp = s
                s = Replace(s, " ", "")
            Loop Until temp = s
            currentPlan = Split(Trim(s), ",")
            arrLength = UBound(currentPlan) - LBound(currentPlan) + 1
            hasElement = False

            If Len(Join(plans)) > 0 Then
                For j = 0 To arrLength - 1
                    pos = Application.Match(currentPlan(j), plans, False)

                    If Not IsError(pos) Then
                        hasElement = True
                        Exit For
                    End If
                Next j
            End If
            If Not hasElement Then
                currentRoutes = currentRoutes & (Join(currentPlan, ",")) & " "
                If Len(Join(plans)) > 0 Then
                    plans = Split(Join(plans, ",") & "," & Join(currentPlan, ","), ",")
                Else
                    plans = currentPlan
                End If
            End If
        Next i
    If locationCount < 0 Then
        locationCount = UBound(plans) - LBound(plans) + 1
    End If

    If (UBound(plans) - LBound(plans) + 1) < locationCount Then
        Debug.Print ("Invalid selection")
    Else
        Debug.Print (Trim(currentRoutes))
        Worksheets("Sheet1").Cells(line, 11) = currentRoutes
        line = line + 1
    End If

    Erase plans
    Debug.Print ("*********")
    Next K


End Sub