今回はデータの組み合わせの作成方法を探る前回記事の続き（2/2）です。 Excel 2016 の場合の「データの取得と変換」を使う方法を紹介します。 また、組み合わせを自動生成するマクロも公開します。
Excel 2010 や 2013 をご使用の方は、前回の記事をご参考にして下さい。
【追記 2021/09/13】 本記事の内容よりもお手軽なバッチとクエリも用意しましたので以下記事もお試しください。 www.shegolab.jp
【追記 2022/04/25】 VBS版 と PowerShell 版も作成しましたのでお試しを。
Excel 2016 / Office 365 ⇒ 「データの取得と変換」を使う
Excel 2016 以降なら新機能の「データの取得と変換」（または「取得と変換」）が使えます。
「データの取得と変換」には高度なデータ加工をサポートするために、データベース並みの様々なデータ結合形式が用意されています。
ところが、またここでもなぜか、肝心のクロス結合機能がありません。
以下に紹介する手順は、「データの取得と変換」によるデータ加工機能を駆使して、結果的にクロス結合と同等の組み合わせデータを生成するものです。
【手順例】「データの取得と変換」を使う
- 作業用に新規ブックを開きます
- 各リストをコピー＆ペーストします
- 同一シート上でかまいません
- リストへのクエリを登録します
- リストとなるセル範囲を選択しておきます
- 「データ」タブ ⇒「データの取得と変換」⇒「テーブルまたは範囲から」を実行
- 「テーブルの作成」ダイアログで見出し行の扱いを指定します
- 「データのインポート」ダイアログでは「接続の作成のみ」を選択しておきます
- 「Power Query エディター」という別ウィンドウが開きます
- その「ファイル」タブ ⇒「閉じて次に読み込む...」を実行
- 「読み込み先」ダイアログで「接続の作成のみ」を選択後、「読み込み」ボタンを押す
- シートの右の「クエリと接続」表示に、各リストが登録されているのを確認
- "テーブル1"、"テーブル2"、"テーブル2"、…といった名前で表示されているはずです
- シート右の「クエリ」から最初のクエリ（"テーブル1"）を右クリックして「参照」を実行
- 再度「Power Query クエリエディター」が開きます
- リストをカスタム列として追加します
- 「列の追加」タブ⇒「カスタム列」⇒「カスタム列」ダイアログ
- 「カスタム列の式」欄に"=テーブル2"を追記
- 同様に"テーブル3"、"テーブル4"…とリストの数だけカスタム列の追加を繰り返します
- 追加したカスタム列のテーブルを展開します
- 各カスタム列の列見出しの右端のアイコンをクリック
- 「OK」を押す
- 組み合わせデータが展開されます
- 「ファイル」タブ ⇒「閉じて次に読み込む」を実行
- 新規シートに組み合わせデータがテーブルとして展開されます
- 新規シートに組み合わせデータがテーブルとして展開されます
- テーブル全体をコピーして本来のブックのシートに「値のみ貼り付け」をします
- 作業用ブックを破棄します
【注意】筆者は Excel 2016 が手元にない状態で本記事を書いているので、細かい確認ができていません。上記手順は Office 365 版での動作とキャプチャですが、ほかのバージョンとの微妙な違いや、間違い記述漏れがあるかもしれませんがご了承ください（GIFアニメもありません😅）
この手順は以下のブログの記事を参考にさせていただきました。
- Cartesian Product Joins (for the Excel person) - The Ken Puls (Excelguru) Blog https://www.excelguru.ca/blog/2016/05/11/cartesian-product-joins-for-the-excel-person/
「データの取得と変換」は Excel 2016 からのデータ分析機能の強化にともなって標準で導入されてた機能で、その実体は「Power Query」というデータ収集・加工ツールです。
それまで「データ」タブにあった「外部データの取り込み」がなくなり、「データの取得と変換」に置き換えられました。 ただし、Office 365 版ではない買い切り版の Excel 2016 では、まだ「取得と変換」という別機能になっています。
もうひとつ関連技術として Excel 2016 には「Power Pivot」という高度なデータ分析・集計のための機能も追加されてます（アドインを有効化する必要があります）。
Power Pivot でも、様々なデータ結合形式が用意はされています。 これもしつこく調べてみましたが、やはりというか、クロス結合はできないようでした。
ありがとう、 Excel さん
さて、いろいろなやり方を見てきましたが、どうでしょうか。
さすが Excel さんと言いたいところですが、どれも一発でやっつけるというには程遠いですね。
手順が煩雑なうえ、普段使わない機能なのでとても覚えきれません。
なにより、何をやってるのかサッパリわかりません。
また、各手順では作業用に新規ブックを用意するようになっていますが、そうしないと、「接続」、「データモデル」、「クエリ」といった「しがらみ」が Excel ファイルに残り、 後で不可解なトラブルのもとになる可能性があるからです。
何をやっているのか理解してちゃんと管理できるかたなら、それらを取っておくのは全然問題ありません。 データ内容の変更があっても「更新」するだけで再作成できて便利です。
でももし、どうしても、分かりやすくて、手順も簡単で、しがらみもなく、一発でやっつけてくれる方法が欲しいというなら、 もうマクロを組んで Excel さんに働いてもらうしかありません。
リストデータの組み合わせを生成するマクロ
複数のリストデータから全ての組み合わせデータを自動生成する Excel マクロを作成しました。
下記マクロを実行すると、指定された複数のセル範囲（リスト）をクロス結合し、新規シートに出力します。
入力となるリストを指定する方法は、そのタイミングをマクロの「実行前」と「実行時」のどちらにするかによって選べるようになっています。
マクロの実行前に、あらかじめ複数のセル範囲を選択しておけば、それらの内容が入力リストとしてクロス結合されます。
複数のセル範囲を選択するには、Ctrlキーを押しながら対象範囲をマウスドラッグします。
実行時の入力ではセル範囲入力ダイアログ使います。 セル範囲の複数選択なしでマクロを実行しすると、実行時入力になります。 このダイアログはちょっと使いづらいのですが、最初の方法と違って別々のシートからも入力できるという利点があります。
マクロは「見出し行あり」と「見出し行なし」の２つを用意しました。 リストの先頭行を見出し扱いするかどうかにより使い分けてください。
Option Explicit Sub 組合せデータ作成_見出しあり() Dim lists As Collection Set lists = inputMultipleRanges() Application.ScreenUpdating = False Call generateCombination(lists, Worksheets.Add.Range("A1"), hasTitle:=True) Application.ScreenUpdating = True End Sub Sub 組合せデータ作成_見出しなし() Dim lists As Collection Set lists = inputMultipleRanges() Application.ScreenUpdating = False Call generateCombination(lists, Worksheets.Add.Range("A1"), hasTitle:=False) Application.ScreenUpdating = True End Sub Private Sub generateCombination(ByVal lists As Collection, ByVal destination As Range, hasTitle As Boolean) If lists.Count = 0 Then Beep: Exit Sub On Error GoTo onError Call validate(lists, destination, hasTitle) If hasTitle Then Set lists = transferTitleRow(lists, destination) Set destination = destination.Offset(1) End If Call crossJoin(lists, destination) Exit Sub onError: MsgBox Err.Description, vbCritical, "組合せデータ作成エラー" End Sub Private Sub crossJoin(ByVal srcRngColl As Collection, ByVal dstRng As Range) Dim saveCalcMode saveCalcMode = Application.Calculation Application.Calculation = xlCalculationManual On Error GoTo final Dim srcRng As Range Dim fieldCount As Long Dim itemCount As Long Dim fillLength As Long Dim frameSize As Long Dim resultSize As Long resultSize = 1 For Each srcRng In srcRngColl resultSize = resultSize * srcRng.Rows.CountLarge Next frameSize = resultSize For Each srcRng In srcRngColl fieldCount = srcRng.Columns.Count itemCount = srcRng.Rows.CountLarge fillLength = frameSize / itemCount With dstRng.Resize(resultSize, fieldCount) .Resize(frameSize).FormulaR1C1 = "=R[1]C[0]" If resultSize > frameSize Then With .Resize(resultSize - frameSize).Offset(frameSize) .FormulaR1C1 = "=R[-" & frameSize & "]C[0]" End With End If Dim i As Integer For i = 1 To fieldCount .Columns(i).NumberFormatLocal = srcRng.Cells(1, i).NumberFormatLocal Next For i = 1 To itemCount .Rows(i * fillLength).Value = srcRng.Rows(i).Value Next .Calculate .Value = .Value End With frameSize = fillLength Set dstRng = dstRng.Offset(, srcRng.Columns.Count) Next final: Application.Calculation = saveCalcMode If Err.Number <> 0 Then Err.Raise Err.Number End Sub Private Function inputMultipleRanges() As Collection Dim coll As New Collection Set inputMultipleRanges = coll If TypeName(Selection) = "Range" Then If 1 < Selection.Areas.Count Then Dim area As Range For Each area In Selection.Areas coll.Add area Next Exit Function End If End If Do coll.Add Application.InputBox( _ Prompt:="次のセル範囲を追加するには「OK」を押してください。" & vbCrLf & _ "終了するには「キャンセル」を押してください", _ title:="複数セル範囲入力", Type:=8) Loop While TypeName(coll(coll.Count)) = "Range" coll.Remove coll.Count End Function Private Function validate(lists As Collection, destination As Range, hasTitle As Boolean) As Collection Dim rowTotalCount As Long rowTotalCount = 1 Dim aList As Object For Each aList In lists If TypeName(aList) <> "Range" Then Err.Raise 999, , "Range 以外を検出" If aList.Cells.Count <> WorksheetFunction.CountA(aList) Then _ Err.Raise 1001, , "空白セルを含めないでください" Dim itemCount As Long itemCount = aList.Rows.CountLarge itemCount = IIf(hasTitle, itemCount - 1, itemCount) If itemCount < 1 Then Err.Raise 1002, , "見出しのみのリストがあります" rowTotalCount = rowTotalCount * itemCount If rowTotalCount > 1000000 Then Err.Raise 1003, , "組合せの数が100万件を超過しています" Next End Function Private Function transferTitleRow(ByVal srcRngColl As Collection, ByVal dstRng As Range) As Collection Set transferTitleRow = New Collection Dim srcRng As Range For Each srcRng In srcRngColl srcRng.Rows(1).Copy dstRng transferTitleRow.Add Intersect(srcRng, srcRng.Offset(1)) Set dstRng = dstRng.Offset(, srcRng.Columns.Count) Next End Function
【使い方】セル範囲選択モード（実行前指定）
- 上記 VBA プログラムを標準モジュールにコピー＆ペーストしておきます
- 入力データリストとなるセル範囲をあらかじめ複数選択します
Ctrlキーを押しながらセル範囲をドラッグ選択します
- 本マクロを実行します
- 新規ワークシートが追加され、全ての組み合わせデータが出力されます
【使い方】ダイアログ入力モード（実行時指定）
- 上記 VBA プログラムを標準モジュールにコピー＆ペーストしておきます
- 本マクロを実行します
- 「セル範囲入力」ダイアログが開きます
- 入力リストとなるセル範囲を指定します
- シート上のセル範囲をドラッグすると自動でそのアドレス表現が入力されます
- 「OK」ボタンを押して、次のリストの入力操作を継続します
- 3 に戻って繰り返します
- 入力対象がなくなったら「キャンセル」ボタンを押して入力を終了します
- 新規ワークシートが追加され、全ての組み合わせデータが出力されます
制限として、空白セルを含むリストがあるとエラーになります。
重複データは排除されません。
通貨、小数点以下の桁数や日付など、データの書式もそのまま保持しますが、 ０詰め数字だけ次の注意が必要です。
「'001」のように先頭にアポストロフィ(')をつけてテキスト化している０詰め数字は再現できません。 ０詰め数字をそのままにしたい場合には、元のリストの方でセルの書式を「文字列」にしてください。
最終的な組み合わせデータの最大行数は 100万行までです。 それ以上はエラーになります。
あまりたくさんのリストを組み合わせると、処理に時間がかかりますので注意して下さい。
【注意】 本マクロの動作結果は利用者の期待する結果と一致する保証はできませんので、処理結果の内容はよくご確認ください。また、明かな間違いや不具合がありましたらコメントなどでお知らせください。
まとめ
Excel はデータを収集・分析する機能が充実していますが、データを作成する方の機能はあまりサポートしてくれません。
今回、そのデータ分析機能を駆使して組み合わせデータを自動生成させてみました。 手順はかなり回りくどい感じになって、ちょっと覚えられませんが、それでも手作業でやる労力を考えれば、だいぶマシといったところでしょう。 何度も繰り返して作業する必要がある方は、マクロのほうの使用も検討してみてください。
本記事の内容は、Windows 10 の Excel 2013 で検証し、一部 Excel 2016 で動作確認しました。
Excel 操作のキャプチャ GIF アニメはScreenToGifを使って作成しました。
