【Excel-VBA】全パターンデータ作成マクロ

はじめに

作成経緯

(正式名称がわからなかったが、)
ある幾つかの項目を全て組み合わせたパターンデータを作成するマクロをつくりたかったが、
思いのほか時間がかかったので忘れないように残しておくことにした。

マクロでやりたかった事

インプット情報

3 X 3 X 2＝だから18通りのデータが出来るはず。

アウトプット情報

項目	項目	項目
すごーい！	君は再帰が苦手なフレンズ	なの？
すごーい！	君は再帰が苦手なフレンズ	なんだね！
すごーい！	君はオブジェクトをNothingしないフレンズ	なの？
すごーい！	君はオブジェクトをNothingしないフレンズ	なんだね！
すごーい！	君はコピペだけが早いフレンズ	なの？
すごーい！	君はコピペだけが早いフレンズ	なんだね！
たのしー！	君は再帰が苦手なフレンズ	なの？
たのしー！	君は再帰が苦手なフレンズ	なんだね！
たのしー！	君はオブジェクトをNothingしないフレンズ	なの？
たのしー！	君はオブジェクトをNothingしないフレンズ	なんだね！
たのしー！	君はコピペだけが早いフレンズ	なの？
たのしー！	君はコピペだけが早いフレンズ	なんだね！
へーきへーき、	君は再帰が苦手なフレンズ	なの？
へーきへーき、	君は再帰が苦手なフレンズ	なんだね！
へーきへーき、	君はオブジェクトをNothingしないフレンズ	なの？
へーきへーき、	君はオブジェクトをNothingしないフレンズ	なんだね！
へーきへーき、	君はコピペだけが早いフレンズ	なの？
へーきへーき、	君はコピペだけが早いフレンズ	なんだね！

ソース

excel-vbaのソース

Option Explicit

Const DELIMITER = ","

Dim m_maxCol As Long
Dim m_x As Long
Dim m_shtMain As Variant
Dim m_shtOut As Variant
Dim m_objOutList As Variant
Dim m_outInList As Variant

Private Sub Init()
    Set m_shtMain = ThisWorkbook.Sheets("Sheet1")
    Set m_shtOut = ThisWorkbook.Sheets("Sheet2")
    Application.ScreenUpdating = False
End Sub

Private Sub Main()
    
   Dim maxRow As Long
   Dim strVal As String
   Dim col As Long
   Dim i As Long
   
   strVal = ""
   m_x = 1
   col = 1
   
   m_maxCol = CLng(InputBox("桁数を入力してください。"))
   
   maxRow = 0
   For i = 1 To m_maxCol
     If i = 1 Then
        maxRow = m_shtMain.Cells(Rows.Count, i).End(xlUp).row
     Else
        maxRow = maxRow * m_shtMain.Cells(Rows.Count, i).End(xlUp).row
     End If
   Next i
   
   '最大行数チェック
   If Rows.Count >= maxRow Then
        
        '初期化
        m_shtOut.Range(m_shtOut.Cells(1, 1), m_shtOut.Cells(Rows.Count, 1)).ClearContents
        
        'リスト生成
        m_objOutList = m_shtOut.Range(m_shtOut.Cells(1, 1), m_shtOut.Cells(maxRow, 1))
        
        m_outInList = m_shtMain.Range(m_shtMain.Cells(1, 1), m_shtMain.Cells(maxRow, m_maxCol))
        '再帰処理
        Call 再帰(strVal, col)
        '出力
        m_shtOut.Range(m_shtOut.Cells(1, 1), m_shtOut.Cells(maxRow, 1)) = m_objOutList
   Else
    Call MsgBox("最大行数を超えるのでNG")
   End If
End Sub


Private Sub 再帰(ByVal strVal, ByRef col)
    Dim row As Long
    Dim strBuf As String
    Dim i As Long
    
    row = m_shtMain.Cells(Rows.Count, col).End(xlUp).row
    strBuf = strVal
    
    For i = 1 To row
        If strVal <> "" Then
            strVal = strVal & DELIMITER & m_outInList(i, col)
        Else
            strVal = m_outInList(i, col)
        End If
        If col < m_maxCol Then
            col = col + 1
            Call 再帰(strVal, col)
            strVal = strBuf
        Else
            m_objOutList(m_x, 1) = strVal
            m_x = m_x + 1
            strVal = strBuf
        End If
    Next i
    
    col = col - 1
        
    
End Sub


Private Sub Dest()
    Application.ScreenUpdating = True
End Sub


Sub test01()
    Call Init
    Call Main
    Call Dest
End Sub

使い方

• エクセルに上記マクロを入れる
• Sheet1,Sheet2を作成する。(Sheet1にはインプット、Sheet2はアウトプットのイメージ)
• Sheet1のA列1行目から任意の列のN行目までデータを入れる。
  
  　(エクセルの最大桁数を超えたら出力出来ないので注意。そこまでデータ作らないかなと思って処理を作らなかった。)
• マクロを実行する(ALT + F8→test01を実行する。)
• [実行後]桁数入力ボックスが表示されるので数値を入力(上記の場合、A～C迄なので3を入力。)
• Sheet2のA列にカンマ区切りで出力される。

最後に

はじめはループ制御だけで行けるかなと思ったけど、
再帰つかわないと厳しいかなと思ってやってみたが中々上手く行かず
コピペプログラマスキルしか無いな自分と痛感した。
多分ループでも行けるんだろうけどなぁと思いつつ、飽きたので終わる。
仕事で再帰を使わざる得ない状況って見たことが無いから多分大丈夫と信じる