Создание комбинации и проверка каждой возможной комбинации

Question

У меня есть столбец (A), имеющий значения

| 3, 4, 5|
|2, 4, 5|
|4, 5|
|2, 3|
|5|
|4|
|3|

и все другие возможные комбинации 3,2 и 1 балл из набора {2,3,4,5}. Я хочу всю возможную комбинацию между этими элементами, чтобы в наборах не было повторения чисел, т.е. |3, 4, 5| можно комбинировать только с |2| или |3, 4|, можно комбинировать только с |2, 5| или |2| и |5|

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

В настоящее время проблема заключается в том, что если выбрана комбинация |3,4|, она проверяет только одну следующую возможную комбинацию, т. Е. Для нее требуется |3,4| & |2,5|, но не проверяется |2| & |5|. Пожалуйста, помогите мне решить эту проблему.

Answer 1

Так что я не поняла ваш запрос.

Я надеюсь, что мое понимание теперь правильно.

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 = 1 To lRowCount - 1
    currentRoutes = ""
    For i = K To lRowCount
        s = ActiveSheet.Cells(i, 1)
        Do
            temp = s
            s = Replace(s, " ", "")
            s = Replace(s, "|", "")
            s = Replace(s, ",", "")
        Loop Until temp = s
        If i = K Then
            currentRoutes = ActiveSheet.Cells(i, 1)
            elements = s
        Else
            hasElement = False
            For j = 1 To Len(s)
                If InStr(elements, Mid(s, j, 1)) > 0 Then hasElement = True: Exit For
            Next j
            If Not hasElement Then
                elements = elements & s
                currentRoutes = currentRoutes & " " & ActiveSheet.Cells(i, 1)
            End If
        End If
    Next i
    Debug.Print (Trim(currentRoutes))
    Worksheets("Sheet1").Cells(line, 11) = currentRoutes
    line = line + 1

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

Answer 2

вот краткий код для генерации всех комбинаций из набора

Sub test()
    Dim a As String
    a = "2345"
    combine a, 3 'list all possible combinations of 3 characters from string a
End Sub
Sub combine(a As String, numberofvalues As Integer, Optional level As Long = 1, Optional solution As String = "", Optional firsti As Long = 1, Optional combinationcount As Long = 0)
    Dim i As Long
    For i = firsti To Len(a)
        solution = solution & Mid(a, i, 1)
        combinationcount = combinationcount + 1
        Sheets("sheet1").Cells(combinationcount, 1) = solution
        If level < numberofvalues Then
            combine a, numberofvalues, level + 1, solution, i + 1, combinationcount
        End If
        solution = Left(solution, Len(solution) - 1)
    Next i
End Sub