組合せ表を作る 2.重複を認めない

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

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

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

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

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

今回は重複チェックで辞書を使っているので、前回よりさらに手間が増えている。
※きっと、もっとスマートな方法があるに違いない。

そこで前回同様、関数で対応することを考えてみた。
※しつこいようだが恐らく、これも既に広く知られている手法と思う。

まず前回同様、関数で組合せ表を作成する。

ここにもう一列追加して、部品1~部品4までの文字種類数を数える。
なお、SUMPRODUCT関数とCOUNTIF関数を組み合わせたこの方法は、
様々なサイトで紹介されているので、そちらを参照してほしい。

あとは、文字種類数が4のものでフィルタをかければよい。

前回に増して万人受けしないものが出来てしまったが、やはり個人的に
嫌いではない。もし採用され場合は、時と場合と各位のお好みで。

参考まで。