組合せ表を作る　２．重複を認めない - Infomentのブログ～Excel VBA奮闘記～

先日は、部品１～部品４が各々ＡからＣの何れかの値を取り得るとき、
その全ての組合せ表を作ることに挑戦した。
infoment.hatenablog.com

今回は、Ａ～ＣではなくＡ～Ｄの何れかの値を取るものとして、
それらが重複しない場合のみの組合せ表を作成してみよう。

重複しないのだから、例えば
・ＡＡＡＡ
・ＡＡＢＣ
のように、同じ文字が二つ以上含まれるものは除外される。
・ＡＢＣＤ
・ＢＣＡＤ
のように、全ての文字が含まれる場合のみ残るわけだ。

重複を許さないということで、お馴染みの辞書（連想配列）を用いて
マクロで作成するなら、例えばこんな感じだろうか。

Sub Sample()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim l As Long
    Dim arr(0 To 4 ^ 4, 1 To 5)
    Dim counter As Long
    Dim Dict As Scripting.Dictionary
    Set Dict = New Dictionary
    
        ' ラベル行データ作成。
        arr(0, 1) = "No."
        arr(0, 2) = "部品1"
        arr(0, 3) = "部品2"
        arr(0, 4) = "部品3"
        arr(0, 5) = "部品4"
        
        ' ボディ部のデータ作成。
        ' "A"が、Chr関数でChr(65)であることを利用している。
        For i = 1 To 4
            For j = 1 To 4
                For k = 1 To 4
                    For l = 1 To 4
                        ' i～lを辞書に登録し、重複がない場合のみ登録する。
                        Dict(i) = i
                        Dict(j) = j
                        Dict(k) = k
                        Dict(l) = l
                        If UBound(Dict.Keys) = 3 Then
                            counter = counter + 1
                            arr(counter, 1) = counter
                            arr(counter, 2) = Chr(i + 64)
                            arr(counter, 3) = Chr(j + 64)
                            arr(counter, 4) = Chr(k + 64)
                            arr(counter, 5) = Chr(l + 64)
                        End If
                        Dict.RemoveAll
        Next l, k, j, i
        
        ' 値貼り付け。
        Range("A1").Resize(counter + 1, 5) = arr
End Sub