VBA Excel: создатель возможных комбинаций, использующий один список элементов без повторяющихся элементов - PullRequest
0 голосов
/ 15 ноября 2018

Sample Screenshot of Excel Sheet

У меня есть следующий лист Excel, в котором построены комбинации случайных чисел с использованием чисел от 2 до 50 в наборе 3, 2 и 1 в столбце А. Япытаясь построить все возможные комбинации между элементами столбца 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...