はじめに

　『Excelで関数型プログラミングに目覚めたのかもしれない』の投稿練習用の記事です。Excelで数独を解く為に作ったツールです。簡単にするために半手動です。バックトラッキング部分のロジックはありません。

~~関数型プログラミングといいながら、らしくないコードですが、分かりやすさ優先です。~~ 時間があったので、より関数型プログラミングらしく書き直しました。

用意した関数

Function DI(R, I, Optional J = 1, Optional S = "")         '
    On Error Resume Next
    If I > 0 Then S = WorksheetFunction.Index(R, I, J)
    DI = S
End Function

' MM,NN ... テーブルで定義された関数の位置情報。

Function MM(R)                          ' TABLE ROW
    MM = Application.ThisCell.Row - R.Row + 1
End Function

Function NN(R)                          ' TABLE COLUMN
    NN = Application.ThisCell.Column - R.Column + 1
End Function

' CC は　CONCAT互換関数です。

Function CC(ParamArray AA())
    On Error Resume Next
    Dim S: S = ""
    Dim I: For I = 0 To UBound(AA)
        S = S & AA(I)
    Next I
    CC = S
End Function

' 追加
Function IFC(C, V, Optional S = "")
    If C Then IFC = V Else IFC = S
End Function

Function RR(R, Optional M = 1, Optional N = 1, Optional H = 0, Optional W = 1, Optional S = "")  ' RANGE RESIZE
    On Error Resume Next
    H = IFC(H = 0, R.Rows.Count - M + 1, H)
    S = R.Offset(M - 1, N - 1).Resize(H, W)

    RR = S
End Function

数独を解く為の関数

Function BB(S1, Optional S = "")
    Dim I: For I = 1 To 9
        If InStr(S1, I) = 0 Then S = CC(S, I)
    Next I
    BB = S
End Function

Function BC(M)
    BC = Int((M - 1) / 3) * 3 + 1
End Function

' 追加
Function BD(R, Optional C = "", Optional S = "")   ' Rの範囲の文字列をCC
   For Each C In R
      S = CC(S, C)
   Next C
   BD = S
End Function

Function NUKU(S1, S2, Optional S3 = "")            ' S1からS2を１回抜く
    NUKU = Replace(S1, S2, S3, 1, 1)
End Function

' 追加した関数を使って書き直し
'
Function AA(R1, R2, Optional S = "")
    Dim M: M = MM(R2)
    Dim N: N = NN(R2)
    Dim K: K = DI(R1, M, N)

    If K = 0 Then
        S = BB(CC(BD(RR(R1, M, 1, 1, 9)), BD(RR(R1, 1, N, 9, 1)), BD(RR(R1, BC(M), BC(N), 3, 3))))
    ElseIf K < 10 Then
        S = K
    End If
    AA = S
End Function

Function AB(R1, R2, R3, Optional S = "")
    Dim M: M = MM(R3)
    Dim N: N = NN(R3)

    If DI(R1, M, N) = "" Then
       Dim K: K = DI(R2, M, N)

       If K < 10 Then
          S = K
       Else
          S = BB(NUKU(BD(RR(R2, BC(M), BC(N), 3, 3)), K))

          If S = "" Then S = BB(NUKU(BD(RR(R2, M, 1, 1, 9)), K))
          If S = "" Then S = BB(NUKU(BD(RR(R2, 1, N, 9, 1)), K))
       End If
    End If

    AB = S

End Function

使用方法

Excelシート上に　9x9のテーブルを３つ並べて用意します。
それぞれ左から、T1_,T2_,T3_と名前をつけます。
T1_は、入力用で、初期状態では、数独の問題を埋めていきます。
T2_は、関数 =AA(T1_,T2_) で全セルを埋めます。
T3_は、関数 =AB(T1_,T2_,T3_) で全セルを埋めます。
テーブルT3_には、一意に決まった数が表示されるので、それを
テーブルT1_に手動で転記します。簡単な問題だとそのまま解けてしまいますが、
難しい問題だと、途中で一意に決まる数字が表示されなくなります。
この場合、将棋の継盤のようにテーブル３つをコピーして手動バックトラック
を行って下さい。
テーブルT2_で、数字が２桁ある場所を見つけて、テーブルT1_にどちらかを転記し、
T3_からT1_への転記を続けます。超難問でも複数の継盤を用意すれば解けるようです。

問題をT1_に入力するとこんな感じになります。

ではでは。