Генератор фраз из заданных фрагментов

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

Постановка задачи

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

В переводе на человеческий язык, это означает, что если в множестве А у нас, например, слова «белый» и «красный», а в множестве В «БМВ» и «Мерседес», то после декартова произведения этих двух наборов мы получим на выходе совокупность всех возможных вариантов фраз, составленных из слов обоих списков:

  • белый БМВ
  • красный БМВ
  • белый Мерседес
  • красный Мерседес

... т.е. как раз то, что нам нужно. Давайте рассмотрим пару способов решения этой задачи в Excel.

Способ 1. Формулы

Начнём с формул. Предположим, что в качестве исходных данных мы имеем три списка исходных слов в столбцах A, B и C, соответственно, причем количество элементов в каждом списке может меняться:

Исходные списки слов

Сначала сделаем три столбца с индексами, т.е. порядковыми номерами слов из каждого списка во всех возможных сочетаниях. Первый ряд единичек (E2:G2) введём вручную, а для остальных используем следующую формулу:

Вычисляем индексы

Логика здесь простая: если индекс в вышестоящей предыдущей ячейке уже дошёл до конца списка, т.е. равен количеству элементов в списке вычисленному функцией СЧЁТЗ (COUNTA), то мы запускаем нумерацию заново. В противном случае - увеличиваем индекс на 1. Обратите особое внимание на хитрое закрепление диапазонов знаками доллара ($), чтобы можно было скопировать формулу вниз и вправо.

Теперь, когда у нас есть порядковые номера нужных нам слов из каждого списка, можно извлечь и сами слова с помощью функции ИНДЕКС (INDEX) в три отдельных столбца:

Извлекаем слова

Если вы раньше не сталкивались в своей работе с этой функцией, то очень советую хотя бы по диагонали её изучить - она выручает в очень многих ситуациях и полезна ничуть не меньше (и даже больше!), чем популярная ВПР (VLOOKUP).

Ну, а после останется только склеить построчно получившиеся фрагменты с помощью символа конкатенации (&):

Склеиваем итоговые фразы

... или (если у вас последняя версия Excel) с помощью удобной функции ОБЪЕДИНИТЬ (TEXTJOIN), умеющей склеивать всё содержимое указанных ячеек через заданный символ-разделитель (пробел):

Склейка текста функцией ОБЪЕДИНИТЬ (TEXTJOIN)

Способ 2. Через Power Query

Power Query - это мощная надстройка для Microsoft Excel, выполняющая две основные задачи: 1. загрузку данных в Excel из почти любых внешних источников и 2. всяческие трансформации загруженных таблиц. Power Query уже встроена в Excel 2016-2019, а для Excel 2010-2013 она устанавливается как отдельная надстройка (скачать можно с официального сайта Microsoft совершенно бесплатно). Если вы ещё не начали использовать Power Query в своей работе, то самое время об этом подумать, ибо преобразования типа вышеописанных делаются там легко и непринужденно, буквально за пару движений.

Сначала загрузим исходные списки как отдельные запросы в Power Query. Для этого для каждой таблицы выполним следующие действия:

  1. Превратим таблицы в "умные" кнопкой Форматировать как таблицу на вкладке Главная (Home - Format as Table) или сочетанием клавиш Ctrl+T. Каждой таблице автоматически будет присвоено имя Таблица1,2,3..., которое, впрочем, можно при желании поменять на вкладке Конструктор (Design).
  2. Установив активную ячейку в таблицу, нажмем кнопку Из таблицы (From Table) на вкладке Данные (Data) или на вкладке Power Query (если она установлена у вас как отдельная надстройка для Excel 2010-2013).
  3. В открывшемся окне редактора запросов выберем команду Главная - Закрыть и загрузить - Закрыть и загрузить в... (Home - Close&Load - Close&Load to..) и затем опцию Только создать подключение (Create only connection). Это оставит загруженную таблицу в памяти и позволит обращаться к ней в будущем.

Если всё сделаете правильно, то на выходе в правой панели должны получиться три запроса в режиме Только подключение с именами наших таблиц:

Загруженные в Power Query таблицы

Теперь щёлкнем правой кнопкой мыши по первому запросу и выберем команду Ссылка (Reference), чтобы сделать его обновляемую копию, а затем добавим к данным дополнительный столбец через команду Добавление столбца ž- Настраиваемый столбец (Add Column -ž Custom Column). В окне ввода формулы введём имя нового столбца (например, Фрагмент2) и предельно простое выражение в качестве формулы:

=Таблица2

... т.е., другими словами, название второго запроса:

Добавляем столбец с формулой

После нажатия на ОК мы увидим новый столбец, в каждой ячейке которого будет лежать вложенная таблица с фразами из второй таблицы (увидеть содержимое этих таблиц можно, если щёлкнуть мышью в фон ячейки рядом со словом Table):

Вложенные таблицы

Останется развернуть всё содержимое этих вложенных таблиц с помощью кнопки с двойными стрелками в заголовке полученного столбца и сняв при этом флажок Использовать исходное имя столбца как префикс (Use original column name as prefix):

Разворачиваем вложенные таблицы

... и мы получим все возможные сочетания элементов из первых двух наборов:

Результат развертывания

Дальше всё аналогично. Добавляем еще один вычисляемый столбец с формулой:

=Таблица3

…, а затем ещё раз разворачиваем вложенные таблицы – и вот у нас уже все возможные варианты перестановок слов из трёх наборов, соответственно:

Развернули третью таблицу

Осталось выделить все три столбца слева-направо, удерживая Ctrl, и сцепить их содержимое через пробел, используя команду Объединить столбцы (Merge Columns) с вкладки Преобразование (Transform):

Сцепляем фрагменты

Получившиеся результаты можно выгрузить обратно на лист знакомой уже командой Главная - Закрыть и загрузить - Закрыть и загрузить в... (Home - Close&Load - Close&Load to..):

Результаты

Если в будущем что-то изменится в наших исходных таблицах с фрагментами, то достаточно будет просто обновить созданный запрос, щёлкнув по результирующей таблице правой кнопкой мыши и выбрав команду Обновить (Refresh) или нажав сочетание клавиш Ctrl+Alt+F5.

Ссылки по теме



21.02.2019 20:05:50
метод с индексами всегда дает осечку, если хотя бы 1 пара длин рядов делится на одно и то же число.
в примере 2 действия 3 объекта и 4 места
пара 2 и 4 делится на 2
в результате генерирует половина комбинаций 12

пользоваться будет неудобно потому что такое будет происходить постоянно

если взять длины рядов [9 9 3] метод будет давать только 4% комбинаций 9/243
при [7 2 3] метод выдаст 100% комбинаций 42/42
удлиняем колонку действий на +1
[8 2 3] и получаем 24 комбинации, что даже меньше чем было
21.02.2019 20:30:35
Согласен.
Поэтому способ с Power Query мне нравится гораздо больше :)
25.02.2019 06:39:11
Доброго времени суток!
Есть ли информация о дате выхода Вашей  книги по Power Query?
18.03.2019 12:28:20
Этот момент можно обойти, если маркировать столбцы для «склейки» иначе.

Ст. «Действие».
Считать последовательность не в форме {1,2,1,2,1,2}, а {1,1,1,2,2,2}. Где кол-во повторов «1» есть произведение кол-во не пустых ячеек ст. «Действие», «Объект», «Место» (данное число является общим количеством уник.комбинаций) / кол-во не пустых ячеек ст. «Действие».

Ст. «Объект».
Считать последовательность не в форме {1,2,3,1,2,3}, а {1,1,1,2,2,2,3,3,3,1,1,1}. Где кол-во повторов «1» считается через Наибольший Общий Делитель (НОД) ст. «Объект» и ст. «Место».

Ст. «Место».
Формируется по старой логике {1,2,3,…,1,2,3} через СЧЁТЗ.

Файл с примером (Я.Диск)
27.02.2019 09:37:04
Расскажите пожалуйста на каком то простом примере суть ошибки, которая может возникнуть. Не хватает серого вещества понять : "метод с индексами всегда дает осечку...".  
18.03.2019 15:01:41
Для примера, составил два листа с примерами, где дубл.строки выделены соотв.цветом.
Надеюсь, станет ясно.

Ссылка на ф.(Я.Диск)
22.02.2019 16:56:24
Декарт скорее отдаленно похож на покойного Девида Байрона из Uriah Heep....Ну да это Вам Николай по возрасту простительно....:)
01.03.2019 10:54:36
хоть бы погуглили перед тем как хвост пушить…
MCH
01.03.2019 16:09:05
Можно было бы добавить 3й способ - макросом, на форуме приводились примеры
02.03.2019 13:12:33
Приветствую!
Дайте, пожалуйста,  ссыль на лучший по вашему мнению вариант для такой комбинаторики. А то вариантов на форуме и правда очень много.
03.03.2019 12:45:31
благодарю) довольно короткий, понятный и быстрый (массивы) код — буду изучать ;)
03.03.2019 09:46:14
Добрый день, Николай!
Спасибо за очередной интересный способ решения нестандартной  задачи вполне стандартными методами excel.Второйй способ с применением Power Query несомненноо гораздо удобнее в применении. Только как же в конце второго способа получить фразу из набора из трех слов? Добавить столбец Слейка и воспользоваться функцией Объединить? Или в Power Query есть какой то свой способ?
03.03.2019 11:29:36
Яна, можно просто выделить все три столбца (с Shift или Ctrl) и выбрать на вкладке Преобразование - Объединить столбцы (Transform - Merge Columns). В статье это, кстати, есть в конце :)
13.03.2019 19:39:03
Подскажите в  Exel 2019 на imac не могу найти кнопку "из таблицы". Есть предположения что не поддерживает Os Mac ?
19.03.2019 22:34:10
В Excel для Mac, к сожалению, полностью отсутствует функционал Power Query :(
31.12.2022 19:47:13
Вариант макросом:
Sub PhrasesGenerator()
    'Long — &, Integer — %, String — $
    Dim arrCountA(), rngColumn As Range, curRange As Range, i&, countCol%, countRows&
    Dim countOfResults&, arrRow(), j&, Str$, arrCurrRange(), arrResult()
    
    If ActiveCell = "" Or ActiveCell.CurrentRegion.Cells.Count = 1 Then
        MsgBox "Выделите непустую ячейку с данными и попробуйте еще раз"
        Exit Sub
    End If
    
    Set curRange = ActiveCell.CurrentRegion 'Диапазон с фразами
    countRows = curRange.Rows.Count
    countCol = curRange.Columns.Count
    'Массив с кол-вом строк в каждом столбце
    ReDim arrCountA(1 To countCol)
    'Меняющийся массив с номерами строк для формирования строки результата
    ReDim arrRow(1 To countCol)
    
    countOfResults = 1
    'Get arrCountA and countOfResults
    For Each rngColumn In curRange.Columns
        i = i + 1
        arrCountA(i) = Application.WorksheetFunction.CountA(rngColumn)
        arrRow(i) = 1
        countOfResults = countOfResults * arrCountA(i)
    Next rngColumn
    
    ReDim arrCurrRange(1 To countRows, 1 To countCol)
    
    'Проверка на случай если результатов будет больше чем строк на листе
    If countOfResults > Cells.Rows.Count - (curRange.Cells(1, 1).Row - 1) Then
        MsgBox "Количество результатов больше чем строк на листе!"
        Exit Sub
    End If
    ReDim arrResult(1 To countOfResults, 1 To 1)
    
    'Fill arrCurrRange from Range
    For i = 1 To countRows
        For j = 1 To countCol
            arrCurrRange(i, j) = curRange.Cells(i, j).Value
        Next j
    Next i
    
    j = 0
    Do While j < countOfResults
            
            'Создаем строку Str имея колонку массива i и строку из массива строк arrRow(i)
            For i = 1 To countCol
                Str = Str & arrCurrRange(arrRow(i), i) & " "
            Next i
            
            'Увеличеваем на 1 самый последний элемент массива со строками
            arrRow(countCol) = arrRow(countCol) + 1
            
            For i = countCol To 2 Step -1
                'Если элемент массива arrRow(i) больше чем в его колонке строк, то
                If arrRow(i) > arrCountA(i) Then
                    'обнуляем его, на подобии разрядов чисел
                    arrRow(i) = 1
                    'а тот разряд что левее увеличиваем на 1
                    arrRow(i - 1) = arrRow(i - 1) + 1
                Else
                    Exit For
                End If
            Next i
            
        j = j + 1
        arrResult(j, 1) = Application.WorksheetFunction.Trim(Str)
        Str = ""
    Loop
    curRange.Cells(1, 1).Offset(0, countCol + 1).Resize(UBound(arrResult, 1), UBound(arrResult, 2)) = arrResult
    MsgBox "Сгенерировано " & countOfResults & " фраз", vbInformation, "Phrases generator"
End Sub
Наверх