Excel VBAマクロでクロス結合テーブルを生成(一次元配列)

Excel VBAマクロでクロス結合テーブルを簡単生成！

データ解析や集計の際、異なるカテゴリーや要素の全ての組み合わせを確認したいことはよくありますよね。この記事では、Excel VBAマクロを使って、複数の配列（リスト）を指定し、それらの全ての組み合わせ（クロス結合/交差結合）を自動で生成する方法を紹介します。

以下のマクロ「CreateCrossJoinTable」の特徴

このマクロでは、ユーザーが複数の配列（一次元リスト）を指定し、それらのクロス結合テーブルを新しいワークシートに自動出力します。単純な操作で、複数のカテゴリーの全ての組み合わせを一覧できるので、商品やイベントのバリエーションを一目で確認するのに役立ちます。

マクロコードと登録方法

以下のコードをVBAエディタに挿入します。コード挿入の手順や詳細な方法は、この後のセクションで説明します。

Sub CreateCrossJoinTable()
    
    Dim inputRanges As Collection
    Dim ws As Worksheet, newWs As Worksheet
    Dim currentRow As Long
    Dim allCombinations As Collection
    Dim rng As Range
    Dim cell As Range
    Dim combination As Variant
    Dim i As Long
    
    ' Initialize
    Set inputRanges = New Collection
    Set allCombinations = New Collection
    Set ws = ActiveSheet
    
    ' Input multiple ranges
    Do
        Set rng = Nothing
        On Error Resume Next
        Set rng = Application.InputBox("Select a range or cancel:", Type:=8)
        On Error GoTo 0
        
        ' Check if Cancel was pressed or no range was selected
        If rng Is Nothing Then
            If inputRanges.Count = 0 Then Exit Sub ' Exit if no ranges have been added
            Exit Do ' Exit loop if at least one range has been added
        End If
        
        inputRanges.Add rng
    Loop
    
    ' Add the first range's items as the first combinations
    For Each cell In inputRanges(1).Cells
        allCombinations.Add Array(cell.Value)
    Next cell
    
    ' For each additional input range, cross join with existing combinations
    For i = 2 To inputRanges.Count
        Set allCombinations = CrossJoin(allCombinations, inputRanges(i))
    Next i
    
    ' Output results to a new worksheet
    Set newWs = Sheets.Add(After:=Sheets(Sheets.Count))
    newWs.Activate
    currentRow = 1
    
    For Each combination In allCombinations
        newWs.Cells(currentRow, 1).Resize(, UBound(combination) + 1).Value = combination
        currentRow = currentRow + 1
    Next combination

End Sub

' Function to cross join two sets of combinations
Function CrossJoin(existingCombinations As Collection, rng As Range) As Collection

    Dim newCombinations As New Collection
    Dim combination As Variant
    Dim newCombination() As Variant
    Dim cell As Range
    Dim i As Long
    
    For Each combination In existingCombinations
        For Each cell In rng.Cells
            ReDim newCombination(LBound(combination) To UBound(combination) + 1)
            For i = LBound(combination) To UBound(combination)
                newCombination(i) = combination(i)
            Next i
            newCombination(UBound(newCombination)) = cell.Value
            newCombinations.Add newCombination
        Next cell
    Next combination
    
    Set CrossJoin = newCombinations

End Function

コード挿入の基本的な手順は次の通りです。

  1. Excelを開き、「開発」タブをクリックします（表示されていない場合は、オプションから設定を変更してください）。
  2. 「Visual Basic」をクリックします。Alt+F11キーでも開きます。
  3. エディタ内で、「挿入」→「標準モジュール」を選択し、新しいモジュールを追加します。
  4. 上記のコードをコピーし、新しいモジュールに貼り付けます。
  5. エディタを閉じ、Excelに戻ります。

マクロの実行と操作手順

マクロの実行は非常にシンプルです。以下の手順で、複数の配列を指定し、それらのクロス結合テーブルを新しいシートに出力します。

  1. 開発タブから「マクロ」をクリックし、「CreateCrossJoinTable」を選択して、「実行」をクリックします。もしくはAlt+F8キーでマクロリストを開いてから「CreateCrossJoinTable」を実行します。

  2. 表示されたインプットボックスで、配列が入力されているセル範囲を指定し、「OK」をクリックします。

  3. 次の配列の範囲を同様に指定します。複数あれば次々と登録していきます。

  4. 全ての配列を指定し終わったら、「キャンセル」をクリックします。

実行結果の確認

マクロを実行すると、新しいワークシートが生成され、指定した配列の全ての組み合わせ、直積集合が出力されます。各配列の要素が横方向に結合され、全ての可能な組み合わせが縦にリストアップされます。

注意点とトラブルシューティング

このマクロを使用する際のいくつかの注意点を挙げます。

  • 配列は1列である必要があります（行方向・あるいは列方向にデータが並んでいること）。
  • Excelの計算量が多くなりすぎると、処理に時間がかかるか、エラーが発生する可能性があります。適切なサイズのデータを指定してください。
  • キャンセルボタンは、配列の指定を終了し、クロス結合を実行するトリガーとなります。キャンセルボタンは途中で終了するのではなく、指定したデータでテーブルを生成します。

以上で、Excel VBAマクロを使って、複数の一次元配列のクロス結合テーブルを自動生成する方法の紹介を終わります。是非、日々のデータ解析や集計作業にお役立てください。

参考：ブラウザ上でクロス結合を実現するツール

以下のページではExcelを用いずにブラウザ上でクロス結合を実現することができます。

文字列群をクロス結合してリストを生成するツール
クロス結合(交差結合)リスト生成ツール 「テーブルのデータ」へ1行1テーブルの形式でテーブルを入力してください。 入力区切り文字が「半角カンマ(,)」ならば 白,黒 ニット,帽子 S,M,L の形式です。 入力区切り文字が「タブ区切り」なら...
www.helpaso.net
2023.09.11

 

コメント

PAGE TOP
タイトルとURLをコピーしました