VBA Excel:使用单个元素列表且没有重复元素的可行组合创建器

时间:2018-11-15 08:45:36

标签: excel vba excel-vba

Sample Screenshot of Excel Sheet

我有以下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

0 个答案:

没有答案