複数カテゴリの値の総組合せを生成したい

目次

1. 今回のVBAマクロについて
2. VBAマクロ解説
3. 終わりに

今回のVBAマクロについて

• Excelでまとめた複数存在するカテゴリの各値の総組合せを生成する

↓

注意点

• 組合せを生成する元となる表は「Sheet1」シートにあるものが対象となっている
• １行目にカテゴリ名が入力されている必要がある
• 表は１行飛ばしで作成しないこと
• カテゴリ名を入力している場合には必ず値を入力すること

コード

これをコピーして実行すれば、組合せを生成できる

Sub GenerateAllCombinations()
    Dim ws As Worksheet
    Dim lastCol As Long
    Dim col As Long
    Dim colCollection As New Collection
    Dim itemNameCol As New Collection
    
    ' 対象のワークシート名を設定
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    For col = 1 To lastCol
        If WorksheetFunction.CountA(ws.Columns(col)) > 0 Then
            Dim cell As Range
            Dim colVals As New Collection
            For Each cell In ws.Columns(col).SpecialCells(xlCellTypeConstants, 3)
                 If cell.Row = 1 Then
                    itemNameCol.Add cell.Value
                    GoTo NextIteration
                 End If
                 colVals.Add cell.Value
                 NextIteration:
            Next cell
            colCollection.Add colVals
            Set colVals = New Collection
        End If
    Next col
    
    Dim srcRng As Collection
    Dim fieldCount As Long
    Dim itemCount As Long
    Dim fillLength As Long
    Dim frameSize As Long
    Dim resultSize As Long
    Dim dstRng As Range
    Dim addWs As Worksheet
    
    Set addWs = Worksheets.Add
    Set dstRng = addWs.Range("A1")
    
    resultSize = 1
    For Each cols In colCollection
        resultSize = resultSize * cols.Count
    Next
    
    frameSize = resultSize
    For Each srcRng In colCollection
        itemCount = srcRng.Count
        fillLength = frameSize / itemCount
        
        With dstRng.Resize(resultSize, 1)
            .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 itemCount
                .Rows(i * fillLength).Value = srcRng(i)
            Next

            .Value = .Value
        End With
        
        frameSize = fillLength
        Set dstRng = dstRng.Offset(, 1)
    Next
    
    addWs.Rows(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    For i = 1 To itemNameCol.Count
        addWs.Cells(1, i).Value = itemNameCol.Item(i)
    Next
    
    MsgBox "OK"
End Sub

VBAマクロ解説

表の読み取り

    Dim ws As Worksheet
    Dim lastCol As Long
    Dim col As Long
    Dim colCollection As New Collection
    Dim itemNameCol As New Collection
    
    ' 対象のワークシート名を設定
    Set ws = ThisWorkbook.Sheets("Sheet1")

    ' 最終列番号を確認　★1
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    ' 列分ループ
    For col = 1 To lastCol
        ' 確認中の列に値が入っていたら読み取り処理を実行
        If WorksheetFunction.CountA(ws.Columns(col)) > 0 Then
            Dim cell As Range
            Dim colVals As New Collection
            ' 確認中の列の値でループ ★2
            For Each cell In ws.Columns(col).SpecialCells(xlCellTypeConstants, 3)
                ' 1行目の時はカテゴリ名用のコレクション変数に保存 
                 If cell.Row = 1 Then
                    itemNameCol.Add cell.Value
                    GoTo NextIteration
                 End If
                 ' ２行目以降は各列の値用コレクション変数に保存
                 colVals.Add cell.Value
                 NextIteration:
            Next cell
            colCollection.Add colVals
            Set colVals = New Collection
        End If
    Next col

ポイント

• ★1：Excelファイルの対象シートの最大列番号から左へ遡って1番最初に値が見つかった列番号を表の最大列番号とみなしている。万が一値が入っていない列が表に存在した場合、表の最大列番号を正しく取得できない可能性があるため
• ★2：確認中の列で数値またはテキストとなっているセルのみ取得しループしている

組合せの出力

    Dim srcRng As Collection
    Dim fieldCount As Long
    Dim itemCount As Long
    Dim fillLength As Long
    Dim frameSize As Long
    Dim resultSize As Long
    Dim dstRng As Range
    Dim addWs As Worksheet

    ' 新しいシートを作成してそこに組合せを生成
    Set addWs = Worksheets.Add
    Set dstRng = addWs.Range("A1")

    ' 総組合せ数を計算
    resultSize = 1
    For Each cols In colCollection
        resultSize = resultSize * cols.Count
    Next
    
    frameSize = resultSize

    ' 各列の値(コレクション変数)でループ
    For Each srcRng In colCollection

        ' 今カテゴリの値出力数の計算　★4
        itemCount = srcRng.Count
        fillLength = frameSize / itemCount

        ' 各列の値出力先セルの設定★3
        With dstRng.Resize(resultSize, 1)
            .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

            ' 各列の値を設定 ★4
            Dim i As Integer
            For i = 1 To itemCount
                .Rows(i * fillLength).Value = srcRng(i)
            Next

            ' セルの値を参照式から実値に設定
            .Value = .Value
        End With

        ' 次カテゴリの値出力数 ★4
        frameSize = fillLength

        ' 出力先セルを次列先頭へ移動
        Set dstRng = dstRng.Offset(, 1)
    Next

    ' １行目に新たに行を挿入し、そこへカテゴリ名を設定
    addWs.Rows(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    For i = 1 To itemNameCol.Count
        addWs.Cells(1, i).Value = itemNameCol.Item(i)
    Next

ポイント

• ★3：値出力先のセルの設定

   With dstRng.Resize(resultSize, 1)
           .Resize(frameSize).FormulaR1C1 = "=R[1]C[0]"

１列分の範囲のセルに対して、総組合せの数だけ１行下のセルを参照する式を設定する。※1
ex. A1セルは１行下のA2セルを参照する。A2セルはA3セルを参照する。・・・

    With .Resize(resultSize - frameSize).Offset(frameSize)
            .FormulaR1C1 = "=R[-" & frameSize & "]C[0]"

※1 で1列分の参照式を設定した後、未出力なカテゴリの総組合せ数だけ下にセル移動をした後、以降のセルに対して（青色セル）、セル移動した分だけ上のセルを参照する式を設定する。
ex. B7セルは移動した分(３×2=６セル分)上のB1セルを参照する。B8セルはB2セルを参照する。・・・
※2 緑色セルは※1で処理した１行下のセルを参照する式が設定されている

⇨２カテゴリ目以降はそれ以前のカテゴリ値の総組合せ分だけ繰り返し同じ値を出力することになるので、緑色セルにて値を設定した後は青色セルでは参照するだけで良くしている。
ex. ２カテゴリ目の値出力時に１カテゴリ目の総組合せ数が１０個の場合、緑色セルの組合せを１０個分出力することになる。
３カテゴリ目の値出力時に１、２カテゴリ目の総組合せが１００個の場合、緑色セルの組合せを１００個分出力することになる。・・・

• ★4：値の設定

itemCount = srcRng.Count
fillLength = frameSize / itemCount

For i = 1 To itemCount
    .Rows(i * fillLength).Value = srcRng(i)
Next

frameSize = fillLength

「★3：出力先のセルの設定」にて参照設定をしたセルに対して上から、各値で必要な組合せの数分だけ下へ移動しながら値を設定する。
ex. 1つ目のカテゴリの各値(10代、２０代・・・)で必要な組合せが６個(登録、編集、削除×男、女)なので６行目のセルに値を設定している。
2つ目のカテゴリの各値(登録、編集、削除)で必要な組合せが２個(男、女)なので２行目のセルに値を設定している。

参考

終わりに

単体テストのテストケース作成を業務で行なったのですが、私が作成したテストケースでは考慮するべきケースが漏れていて、それによってバグ検知が遅れてしまうことが多発していました。。

この経験から、今回のQiita投稿では、勉強というよりかは業務で使える便利なコードを書きたいというところからVBAのマクロを作成しました。

このコードを使って総組合せを生成した後、不要なケースは削除するのは良いと思うので、これで手作業でテストケースを考える手間を少しでも軽減できればなと思います。