数独をVBAで解いてみる ④

昨日は、数独をVBAで解くコードに新たなロジックを追加してみた。
infoment.hatenablog.com
今日は、答えが出るまで繰り返し処理を行わせることに挑戦する。
f:id:Infoment:20190505153730p:plain

単純に繰り返すなら、For ~ Next ループが手っ取り早い。

Sub Sample()
    Dim i As Long
        For i = 1 To 10
            Call 何某かの処理
        Next
End Sub

この方法の場合、ループ変数iは、何某かの処理と全く無関係でも構わない。でも今回は、再帰呼び出しで行ってみた。
まず、総処理数を数えるために、カウンターを一つ準備する。加えて、最大処理数用にも変数を準備。

' モジュールレベル変数
' Analizeの処理回数カウント用。
Dim TotalCounter As Long
' 最大処理数。
Dim MaxTry As Long

これらの変数は、クラスモジュールの初期化時に初期設定する。

Private Sub Class_Initialize()
    ' 画面更新の一時停止。
    Application.ScreenUpdating = False

    ' 今回追加個所。
    TotalCounter = 0
    MaxTry = 100
End Sub

解析用モジュールに、再帰呼び出し箇所を追加。

Public Sub Analize()
    Dim r As Long
    Dim c As Long
        For r = 1 To 9
            For c = 1 To 9
                CheckNumber r, c
            Next
        Next
        
        ' 今回追加個所。
        ' 最大処理数に達していた場合、処理終了。
        If TotalCounter = MaxTry Then
            Exit Sub
        End If
        
        ' マスに一つでも0があれば、つまり未解決のマスが
        ' 一つでもある場合、再帰呼び出しで処理を行う。
        For r = 1 To 9
            For c = 1 To 9
                If ArrNum(r, c) = 0 Then
                    TotalCounter = TotalCounter + 1
                    Call Analize
                    Exit Sub
                End If
            Next
        Next
End Sub

最後に、処理回数の表示を追加する。

Private Sub Class_Terminate()
    TableRange = ArrNum
    TableRange.Replace 0, vbNullString
    Application.ScreenUpdating = True
    
    ' 今回追加個所。
    If TotalCounter = MaxTry Then
        MsgBox "試行が規定回数(" & MaxTry & "回)に達したため、処理を中断します。"
    Else
        MsgBox "繰り返し回数:" & TotalCounter
    End If
End Sub

以上を組み込んだところまでで、某サイトの問題を解いてみると、中級編まではほぼ問題なく全てのマスを埋めることが出来るようになった。

f:id:Infoment:20190505155830g:plain

しかし現時点では、まだまだ上級レベルには太刀打ちできない。

次回に続きます。

参考まで。