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

Ответ 1

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

Это способ генерации декартово произведение двух или более одномерных массивов данных с использованием Excel и Microsoft Query.

Эти инструкции были написаны с XL2007, но должны работать с незначительными (если есть) модификациями в любой версии.

Шаг 1

Организуйте массивы в столбцах.

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

Выберите каждый диапазон данных по очереди, включая как "заголовки", так и нажмите Ctrl+Shift+F3. Отметьте только Top row в диалоговом окне "Создать имена" и нажмите OK.

Как только все именованные диапазоны будут установлены, сохраните файл.

Шаг 2

Данные | Получить внешние данные | Из других источников | Из запроса Microsoft

Выберите <New Data Source>. В диалоговом окне Choose New Data Source:

• Дружественное имя для вашего подключения

• выберите соответствующий драйвер Microsoft Excel

... then Connect

Шаг 3

Select Workbook... затем найдите файл.

Шаг 4

Добавьте "столбцы" из ваших "таблиц". Теперь вы можете видеть, почему макет "двух заголовков" на шаге 1 важен - он правильно использует драйвер для правильного понимания данных.

Затем нажмите Cancel (действительно!). На этот момент вам может быть предложено "продолжить редактирование в Microsoft Query?". (ответ Yes), или жалоба, которая присоединяется, не может быть представлена ​​в графическом редакторе. Игнорировать это и подделывать...

Шаг 5

Microsoft Query открывается, и по умолчанию добавленные вами таблицы будут сгруппированы. Это порождает декартово произведение, которое мы хотим.

Теперь полностью закрыть MSQuery.

Шаг 6

Вы вернетесь на рабочий лист. Я почти обещаю! Отметьте New worksheet и OK.

Шаг 7

Полученные скрещенные результаты возвращаются.

Ответ 2

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

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. Еще один вариант, о котором я могу думать, - записать вывод в текстовый файл в таком сценарии. Если ваши данные малы, вы можете уйти без использования массивов и напрямую писать в ячейки.:) Но в случае больших данных я бы рекомендовал использовать массивы.

Ответ 3

Мне это нужно было несколько раз и, наконец, построил.

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

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

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

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

Как это работает (кратко): сначала для каждого столбца и для каждой строки: он вычисляет количество общих строк, необходимых для поддержки всех комбо в 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

Ответ 4

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

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

Вкл Sheet2:

Формулы

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

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

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

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

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

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

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

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

Ответ 5

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

Пример:

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