Excel vba для создания всех возможных комбинаций диапазона

не уверен, почему вы не любите цикл. См. этот пример. Это заняло меньше секунды.

Option Explicit

Sub Sample()
    Dim i As Long, j As Long, k As Long, l As Long
    Dim CountComb As Long, lastrow As Long

    Range("G2").Value = Now

    Application.ScreenUpdating = False

    CountComb = 0: lastrow = 6

    For i = 1 To 4: For j = 1 To 4
    For k = 1 To 8: For l = 1 To 12
        Range("G" & lastrow).Value = Range("A" & i).Value & "/" & _
                                     Range("B" & j).Value & "/" & _
                                     Range("C" & k).Value & "/" & _
                                     Range("D" & l).Value
        lastrow = lastrow + 1
        CountComb = CountComb + 1
    Next: Next
    Next: Next

    Range("G1").Value = CountComb
    Range("G3").Value = Now

    Application.ScreenUpdating = True
End Sub

снимок

Примечание: выше был небольшой пример. Я сделал тест на 4 столбцах с 200 строками каждый. Общая комбинация, возможная в таком сценарии, -1600000000 и это заняло 16 секунд.

в таком случае он пересекает предел строк Excel. Еще один вариант, который я могу придумать, - это написать вывод в текстовый файл в таком сценарии. Если ваши данные малы, вы можете уйти без использования массивов и непосредственно писать в ячейки. :) Но в случае больших данных я бы рекомендовал использовать массивы.

Я сам нуждался в этом несколько раз и, наконец, построил его.

Я считаю, что код масштабируется для любого общего количества столбцов и любого количества различных значений в Столбцах (например, каждый столбец может содержать любое количество значений)

предполагается, что все значения в каждом столбце уникальны (если это не так, вы будете получать повторяющиеся строки)

предполагается, что вы хотите объединить выходные данные на основе выбранных вами ячеек (убедитесь, что вы их выбрали все)

предполагается, что вывод должен начинаться с одного столбца после текущего выделения.

Как это работает (кратко): сначала для каждого столбца и для каждой строки: он вычисляет количество общих строк, необходимых для поддержки всех комбо в N столбцах (элементы в столбце 1 * элементы в столбце 2 ... * элементов в столбце N)

секунда для каждого столбца: на основе общих комбо и общих комбо предыдущих столбцов он вычисляет два цикла.

ValueCycles (сколько раз вам нужно перебрать все значения в текущем столбце) ValueRepeats (сколько раз повторять каждое значение в столбце последовательно)

Sub sub_CrossJoin()

Dim rg_Selection As Range
Dim rg_Col As Range
Dim rg_Row As Range
Dim rg_Cell As Range
Dim rg_DestinationCol As Range
Dim rg_DestinationCell As Range
Dim int_PriorCombos As Long
Dim int_TotalCombos As Long
Dim int_ValueRowCount As Long
Dim int_ValueRepeats As Long
Dim int_ValueRepeater As Long
Dim int_ValueCycles As Long
Dim int_ValueCycler As Long

int_TotalCombos = 1
int_PriorCombos = 1
int_ValueRowCount = 0
int_ValueCycler = 0
int_ValueRepeater = 0

Set rg_Selection = Selection
Set rg_DestinationCol = rg_Selection.Cells(1, 1)
Set rg_DestinationCol = rg_DestinationCol.Offset(0, rg_Selection.Columns.Count)

'get total combos
For Each rg_Col In rg_Selection.Columns
    int_ValueRowCount = 0
    For Each rg_Row In rg_Col.Cells
        If rg_Row.Value = "" Then
            Exit For
        End If
        int_ValueRowCount = int_ValueRowCount + 1
    Next rg_Row
    int_TotalCombos = int_TotalCombos * int_ValueRowCount
Next rg_Col

int_ValueRowCount = 0

'for each column, calculate the repeats needed for each row value and then populate the destination
For Each rg_Col In rg_Selection.Columns
    int_ValueRowCount = 0
    For Each rg_Row In rg_Col.Cells
        If rg_Row.Value = "" Then
            Exit For
        End If
        int_ValueRowCount = int_ValueRowCount + 1
    Next rg_Row
    int_PriorCombos = int_PriorCombos * int_ValueRowCount
    int_ValueRepeats = int_TotalCombos / int_PriorCombos


    int_ValueCycles = (int_TotalCombos / int_ValueRepeats) / int_ValueRowCount
    int_ValueCycler = 0

    int_ValueRepeater = 0

    Set rg_DestinationCell = rg_DestinationCol

    For int_ValueCycler = 1 To int_ValueCycles
        For Each rg_Row In rg_Col.Cells
            If rg_Row.Value = "" Then
                Exit For
            End If

                For int_ValueRepeater = 1 To int_ValueRepeats
                    rg_DestinationCell.Value = rg_Row.Value
                    Set rg_DestinationCell = rg_DestinationCell.Offset(1, 0)
                Next int_ValueRepeater

        Next rg_Row
    Next int_ValueCycler

    Set rg_DestinationCol = rg_DestinationCol.Offset(0, 1)
Next rg_Col
End Sub

решение на основе моего второго комментария. В этом примере предполагается, что у вас есть три столбца данных, но их можно адаптировать для обработки большего количества.

Я начинаю с ваших выборочных данных. Для удобства я добавил графы в верхний ряд. Я также добавил общее количество комбинаций (произведение подсчетов). Это Sheet1:

On Sheet2:

Формулы:

A2:C2 (оранжевые ячейки) жестко закодированы =0

A3=IF(SUM(B3:C3)=0,MOD(A2+1,Sheet1!$E),A2)

B3=IF(C3=0,MOD(B2+1,Sheet1!$G),B2)

C3=MOD(C2+1,Sheet1!$J)

D2=INDEX(Sheet1!$E:$E,Sheet2!A2+1)

E2=INDEX(Sheet1!$G:$G,Sheet2!B2+1)

F2=INDEX(Sheet1!$J:$J,Sheet2!C2+1)

заполнить из строки 3 вниз столько строк, сколько Total показывает Sheet1

вызовите метод и поместите в текущий уровень, который будет уменьшен в методе (извините за eng)

пример:

    sub MyAdd(i as integer)
      if i > 1 then
        MyAdd = i + MyAdd(i-1)
      else
        MyAdd = 1
      end if
    end sub