소개

작성 경위

(정식 명칭을 몰랐지만,)
어느 몇개의 항목을 모두 조합한 패턴 데이터를 작성하는 매크로를 만들고 싶었지만,
생각 외에 시간이 걸렸기 때문에 잊지 않도록 남겨두기로 했다.

매크로로 하고 싶었던 일

입력 정보

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열에 쉼표로 구분하여 출력된다.

마지막으로

처음에는 루프 제어만으로 갈 수 있을까 생각했지만,
재귀를 잡지 않으면 어려울까라고 생각해 보았지만 나중에 잘 가지 않고
코피페 프로그래머 스킬밖에 없는 자신과 통감했다.
어쩌면 루프에서도 갈 수 있겠지만 생각하고, 질리기 때문에 끝난다.
일로 재귀를 쓸 수 없는 상황이라고 본 적이 없으니까 아마 괜찮다고 믿는다