複数リストから全ての組み合わせデータを作りたい（2/2）

今回はデータの組み合わせの作成方法を探る前回記事の続き（2/2）です。 Excel 2016 の場合の「データの取得と変換」を使う方法を紹介します。 また、組み合わせを自動生成するマクロも公開します。

Excel 2010 や 2013 をご使用の方は、前回の記事をご参考にして下さい。

www.shegolab.jp

【追記 2021/09/13】 本記事の内容よりもお手軽なバッチとクエリも用意しましたので以下記事もお試しください。 www.shegolab.jp

【追記 2022/04/25】 VBS版 と PowerShell 版も作成しましたのでお試しを。

www.shegolab.jp

Excel 2016 / Office 365 ⇒ 「データの取得と変換」を使う

Excel 2016 以降なら新機能の「データの取得と変換」（または「取得と変換」）が使えます。

「データの取得と変換」には高度なデータ加工をサポートするために、データベース並みの様々なデータ結合形式が用意されています。

ところが、またここでもなぜか、肝心のクロス結合機能がありません。

以下に紹介する手順は、「データの取得と変換」によるデータ加工機能を駆使して、結果的にクロス結合と同等の組み合わせデータを生成するものです。

【手順例】「データの取得と変換」を使う

1. 作業用に新規ブックを開きます
2. 各リストをコピー＆ペーストします
   • 同一シート上でかまいません
3. リストへのクエリを登録します
   1. リストとなるセル範囲を選択しておきます
   2. 「データ」タブ ⇒「データの取得と変換」⇒「テーブルまたは範囲から」を実行
      • 「テーブルの作成」ダイアログで見出し行の扱いを指定します
      • 「データのインポート」ダイアログでは「接続の作成のみ」を選択しておきます
   3. 「Power Query エディター」という別ウィンドウが開きます
   4. その「ファイル」タブ ⇒「閉じて次に読み込む...」を実行
   5. 「読み込み先」ダイアログで「接続の作成のみ」を選択後、「読み込み」ボタンを押す
4. シートの右の「クエリと接続」表示に、各リストが登録されているのを確認
   • "テーブル1"、"テーブル2"、"テーブル2"、…といった名前で表示されているはずです
5. シート右の「クエリ」から最初のクエリ（"テーブル1"）を右クリックして「参照」を実行
6. 再度「Power Query クエリエディター」が開きます
7. リストをカスタム列として追加します
   1. 「列の追加」タブ⇒「カスタム列」⇒「カスタム列」ダイアログ
   2. 「カスタム列の式」欄に"=テーブル2"を追記
   3. 同様に"テーブル3"、"テーブル4"…とリストの数だけカスタム列の追加を繰り返します
8. 追加したカスタム列のテーブルを展開します
   1. 各カスタム列の列見出しの右端のアイコンをクリック
   2. 「OK」を押す
   3. 組み合わせデータが展開されます
9. 「ファイル」タブ ⇒「閉じて次に読み込む」を実行
   • 新規シートに組み合わせデータがテーブルとして展開されます
10. テーブル全体をコピーして本来のブックのシートに「値のみ貼り付け」をします
11. 作業用ブックを破棄します

【注意】筆者は 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

【使い方】セル範囲選択モード（実行前指定）

1. 上記 VBA プログラムを標準モジュールにコピー＆ペーストしておきます
2. 入力データリストとなるセル範囲をあらかじめ複数選択します
   • Ctrl キーを押しながらセル範囲をドラッグ選択します
3. 本マクロを実行します
4. 新規ワークシートが追加され、全ての組み合わせデータが出力されます

【使い方】ダイアログ入力モード（実行時指定）

1. 上記 VBA プログラムを標準モジュールにコピー＆ペーストしておきます
2. 本マクロを実行します
3. 「セル範囲入力」ダイアログが開きます
4. 入力リストとなるセル範囲を指定します
   • シート上のセル範囲をドラッグすると自動でそのアドレス表現が入力されます
5. 「OK」ボタンを押して、次のリストの入力操作を継続します
   • 3 に戻って繰り返します
6. 入力対象がなくなったら「キャンセル」ボタンを押して入力を終了します
7. 新規ワークシートが追加され、全ての組み合わせデータが出力されます

制限として、空白セルを含むリストがあるとエラーになります。

重複データは排除されません。

通貨、小数点以下の桁数や日付など、データの書式もそのまま保持しますが、 ０詰め数字だけ次の注意が必要です。

「'001」のように先頭にアポストロフィ(')をつけてテキスト化している０詰め数字は再現できません。 ０詰め数字をそのままにしたい場合には、元のリストの方でセルの書式を「文字列」にしてください。

最終的な組み合わせデータの最大行数は 100万行までです。 それ以上はエラーになります。

あまりたくさんのリストを組み合わせると、処理に時間がかかりますので注意して下さい。

【注意】 本マクロの動作結果は利用者の期待する結果と一致する保証はできませんので、処理結果の内容はよくご確認ください。また、明かな間違いや不具合がありましたらコメントなどでお知らせください。

まとめ

Excel はデータを収集・分析する機能が充実していますが、データを作成する方の機能はあまりサポートしてくれません。

今回、そのデータ分析機能を駆使して組み合わせデータを自動生成させてみました。 手順はかなり回りくどい感じになって、ちょっと覚えられませんが、それでも手作業でやる労力を考えれば、だいぶマシといったところでしょう。 何度も繰り返して作業する必要がある方は、マクロのほうの使用も検討してみてください。

本記事の内容は、Windows 10 の Excel 2013 で検証し、一部 Excel 2016 で動作確認しました。

Excel 操作のキャプチャ GIF アニメはScreenToGifを使って作成しました。

関連記事

www.shegolab.jp

www.shegolab.jp

www.shegolab.jp

www.shegolab.jp