数独（再挑戦）⑥ 一つしかないなら、それで確定（の続き）

昨日は、行内に一つしかない数字があったならば、その数字でセルを確定させることに挑戦した。
infoment.hatenablog.com

昨日は「行」を作成したところで時間切れ。今日は残りに挑戦する。

単純に１行ないし１列抜き出して調べるのは、あまり難しくない。しかし３×３や９×９，２７×２７などとなれば、途端にややこしくなる。

今回はこのために、二つの関数を新たに作成した。

1. 配列の中で、Resizeっぽくその一部を抽出
2. 配列の中で、指定値を探してその行列番号を返す

Private Sub UniqueExistence()
    Dim r As Long, r2 As Long
    Dim c As Long, c2 As Long
    Dim arr As Variant
    Dim i As Long
        For r = 1 To 27
            ' １行スライスして、新たな配列を作成する。
            arr = WorksheetFunction.Index(TempArray, r, 0)
            ' この配列に１～９の値が幾つ含まれるか確認する。
            For i = 1 To 9
                ' 調査した値が一つしかない場合、確定可能。
                If ArrayCountIF(arr, i) = 1 Then
                    ' 一つしかなかった値の列番号を取得。
                    ' ※完全一致で取得しない場合、正しい結果にならない。要注意。
                    c = WorksheetFunction.Match(i, arr, 0)
                    ' ２７×２７の行列を、９×９に換算する。
                    r2 = WorksheetFunction.RoundUp(r / 3, 0)
                    c2 = WorksheetFunction.RoundUp(c / 3, 0)
                    ' 上記で求めたセルの値が未確定の場合、確定させる。
                    If FixedNumber(r2, c2) = 0 Then
                        FixedCell r2, c2, i
                    End If
                End If
            Next
        Next
        
        ' -----------------------↓↓本日追加↓↓-------------------------
        
        For c = 1 To 27
            ' １行スライスして、新たな配列を作成する。
            arr = WorksheetFunction.Index(TempArray, 0, c)
            ' この配列に１～９の値が幾つ含まれるか確認する。
            For i = 1 To 9
                ' 調査した値が一つしかない場合、確定可能。
                If ArrayCountIF(arr, i) = 1 Then
                    ' 一つしかなかった値の列番号を取得。
                    ' ※完全一致で取得しない場合、正しい結果にならない。要注意。
                    r = WorksheetFunction.Match(i, arr, 0)
                    ' ２７×２７の行列を、９×９に換算する。
                    r2 = WorksheetFunction.RoundUp(r / 3, 0)
                    c2 = WorksheetFunction.RoundUp(c / 3, 0)
                    ' 上記で求めたセルの値が未確定の場合、確定させる。
                    If FixedNumber(r2, c2) = 0 Then
                        FixedCell r2, c2, i
                    End If
                End If
            Next
        Next
        
        ' ２７×２７のうち、９等分した９×９の範囲について、一つしか存在しない
        ' 数を探す。もしあれば、その数でセルを確定させる。
        For r = 1 To 19 Step 9
            For c = 1 To 19 Step 9
                ' 配列をリサイズして、９×９の範囲を取得。
                arr = ResizeArray(TempArray, r, c, 9, 9)
                For i = 1 To 9
                    If ArrayCountIF(arr, i) = 1 Then
                        r2 = FindInArray(arr, i)(0) + r - 1
                        c2 = FindInArray(arr, i)(1) + c - 1
                        ' ９×９の行列番号に換算する。
                        r2 = WorksheetFunction.RoundUp(r2 / 3, 0)
                        c2 = WorksheetFunction.RoundUp(c2 / 3, 0)
                        FixedCell r2, c2, i
                    End If
                Next
            Next
        Next
End Sub

' 元の配列から、指定位置を起点として、指定行数×指定列数を抜き出す。
Private Function ResizeArray(source_array As Variant, _
                             start_r_index As Long, _
                             start_c_index As Long, _
                             array_height As Long, _
                             array_width As Long) As Variant
    Dim arr() As Variant
    ReDim arr(1 To array_height, 1 To array_width)
    Dim r As Long
    Dim c As Long
        For r = 1 To array_height
            For c = 1 To array_width
                arr(r, c) = source_array(start_r_index + r - 1, _
                                         start_c_index + c - 1)
            Next
        Next
    
        ResizeArray = arr
End Function

' 指定配列内で指定値を探し、最初に見つけた値の行番号と列番号を返す。
Private Function FindInArray(source_array As Variant, _
                             faWhat As Long) As Variant
    Dim r As Long
    Dim c As Long
        For r = LBound(source_array, 1) To UBound(source_array, 1)
            For c = LBound(source_array, 2) To UBound(source_array, 2)
                If source_array(r, c) = faWhat Then
                    FindInArray = Array(r, c)
                    Exit For
                End If
            Next
        Next
End Function

結果、新たに３つのセル（黄色）で数値が確定した。

思ったより増えなかったな。
明日に続きます。

参考まで。