はじめに
作成経緯
(正式名称がわからなかったが、)
ある幾つかの項目を全て組み合わせたパターンデータを作成するマクロをつくりたかったが、
思いのほか時間がかかったので忘れないように残しておくことにした。
マクロでやりたかった事
インプット情報
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列にカンマ区切りで出力される。
最後に
はじめはループ制御だけで行けるかなと思ったけど、
再帰つかわないと厳しいかなと思ってやってみたが中々上手く行かず
コピペプログラマスキルしか無いな自分と痛感した。
多分ループでも行けるんだろうけどなぁと思いつつ、飽きたので終わる。
仕事で再帰を使わざる得ない状況って見たことが無いから多分大丈夫と信じる