t-hom’s diary

主にVBAネタを扱っているブログ…とも言えなくなってきたこの頃。

VBA 汎用的な順列作成プログラム

今回の記事は、先日取り組んだ以下の書籍のつづき。

Excel VBAでパズルを解こう

Excel VBAでパズルを解こう

前回作成したプログラムは、順列数が固定のものだった。
thom.hateblo.jp

今回はたとえば、N種類の中からM個を取り出して並べるパターンを出力させる汎用的なプログラムを作る。

Nを要素数=5、Mを列数=3として定数宣言している。
以下のコードでは、5種類の中から3つを取り出して並べるパターンをイミディエイトウインドウに出力する。

Option Explicit
Sub 順列作成()
    Const 要素数 = 5, 列数 = 3
    Dim i As Integer, j As Integer, k As Integer

    Dim 新順列() As Integer: ReDim 新順列(1 To 列数)    
    For i = 1 To 列数
        新順列(i) = i
    Next
    
    Dim 順列コレクション As New Collection
    順列コレクション.Add 新順列
    
    Dim 作業順列コレクション As New Collection
    
    Dim 要素A As Integer, 要素B As Integer, 既存順列 As Variant
    
    For 要素A = 要素数 - 1 To 1 Step -1
        For 要素B = 要素A + 1 To 要素数
            For Each 既存順列 In 順列コレクション
                Dim 入替済 As Boolean: 入替済 = False
                For j = 1 To 列数
                    Select Case 既存順列(j)
                        Case 要素A: 新順列(j) = 要素B: 入替済 = True
                        Case 要素B: 新順列(j) = 要素A: 入替済 = True
                        Case Else: 新順列(j) = 既存順列(j)
                    End Select
                Next
                If 入替済 Then 作業順列コレクション.Add 新順列
            Next
        Next
        Dim 順列
        For Each 順列 In 作業順列コレクション
            順列コレクション.Add 順列
        Next
        Set 作業順列コレクション = New Collection
    Next

    Dim 出力順列
    For Each 出力順列 In 順列コレクション
        For k = 1 To 列数
            Debug.Print 出力順列(k);
        Next
        Debug.Print
    Next
End Sub

アルゴリズムは書籍で紹介されているものと同じだが、元のコードではコレクションではなく配列が使われている。
配列のほうがメモリ効率が良く、後でセル転機しようと思ったときは簡単で、しかもスピードが速い。
しかし配列はどこに書き込むか具体的に指定しないといけないので、複雑な処理では頭がこんがらがってくる。

そこで、作成する各順列は1次元配列(新順列)で表し、その配列を順列コレクションに追加していくことにした。

さて、コレクションのおかげでシンプルにはなったが、それでもこのコードが何をやっているのか理解するのは難しい。
ループの中で要素Aと要素Bを入れ替えているのだが、特に要素AとBの変化が分かりづらいため、シートモジュールに次のようなマクロを作成した。

Sub 入替箇所の確認()
    要素数 = 9
    For 要素A = 要素数 - 1 To 1 Step -1
        For 要素B = 要素A + 1 To 要素数
            Range("b3:j4").ClearContents
            Range("a3").Offset(0, 要素A).Value = "A"
            Range("a4").Offset(0, 要素B).Value = "B"
            Stop
        Next
    Next
End Sub

シートのはこのようにB2:J2に数字を入れておく。
f:id:t-hom:20150919235755p:plain

実行時は、シートとVBエディタが両方見えるように並べておく。

実行すると、Stop命令で中断モードになり、8の下にA、9の下ひとつ飛ばしてBが入る。
中断モードで何度かF5で継続実行すると、そのたびにAとBがどう変化するかが分かる。
※終了するにはVBEのリセットボタンか、実行メニューのリセットをクリック

これで要素Aと要素Bの動きが視覚的にとらえられる。

さらに数値がどう入れ替わるのかを確認するため、実際に数値を入れ替える処理も入れてみた。

Sub 入替箇所の確認2()
    要素数 = 9
    For 要素A = 要素数 - 1 To 1 Step -1
        For 要素B = 要素A + 1 To 要素数
            Range("b3:j4").ClearContents
            Range("a3").Offset(0, 要素A).Value = "A"
            Range("a4").Offset(0, 要素B).Value = "B"
            With Range("a2")
                temp = .Offset(0, 要素A)
                .Offset(0, 要素A) = .Offset(0, 要素B)
                .Offset(0, 要素B) = temp
            End With
            Stop
        Next
    Next
End Sub

これで要素Aと要素Bの働きは分かった。

次にややこしいのは処理の中心部分である。

Dim 入替済 As Boolean: 入替済 = False
For j = 1 To 列数
    Select Case 既存順列(j)
        Case 要素A: 新順列(j) = 要素B: 入替済 = True
        Case 要素B: 新順列(j) = 要素A: 入替済 = True
        Case Else: 新順列(j) = 既存順列(j)
    End Select
Next
If 入替済 Then 作業順列コレクション.Add 新順列

基本的に要素Aと要素Bを入れ替えるのだが、入れ替えても新しい順列が発生しないケースもある。
たとえば、9種類のうち5個をとって並び替えるパターンでは、有効列は5つしかない。

有効列を黄色で示した。

f:id:t-hom:20150920001520p:plain

この場合、末尾の8と9を入れ替えても有効列の並びパターンは変わらないので新規順列として登録はできない。

既存順列に要素Aか要素Bのどちらか、あるいは両方が登場した場合に、AとBを入れ替える。
どちらも登場しない場合は入替されないので、新順列はコレクションに登録されない。
ここでやっているのはそのような処理である。

要素Bのループでは新規の順列を一旦作業順列コレクションに追加し、ループを抜けた時点で順列コレクションに書き込んでいる。
既存順列は、2倍、3倍、4倍という増え方をするようだ。
素数9、列数5でやってみたら、5倍から始まって、6倍、7倍、8倍、9倍まで増えた。

何度か検証したところ、(要素数-列数)倍からスタートして、要素数倍まで増えているようである。

書籍に書かれているコードはそのままではさっぱり理解できなかったが、いろいろ弄ることでようやくアルゴリズムの流れがイメージできるようになった。

人の書いたコードを理解するためには、やはり自分で書き直してみるのが早い。
そのときに、役割の判明した変数は、なるべく自分が直感的に理解できる言葉で名前を付けなおすと良い。
また、処理の細部がトレースしきれないということもあると思うが、配列をコレクションに変えたりといった抽象化を図るとすこし分かりやすくなる。

一度で分からなくても、元のコードを書き直す作業を何度か繰り返しているうちにつかめてくるようになる。

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。