用EXCEL解数独

用EXCEL解数独

用EXCEL解数独代码:

Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Option Explicit
 
' 機能:取得数字
' 引数:基礎値、行数、列数
Public Function getValOfRowCol(baseVal As Integer, rowNo As Integer, colNo As Integer) As Integer
 
    Dim val As Integer
     
    getValOfRowCol = 0
     
    If Cells(rowNo, colNo) = "" Then
        '空白
        For val = baseVal To 9
            If checkRow(val, rowNo) = 0 Then
                If checkCol(val, colNo) = 0 Then
                    If checkBlock(val, rowNo, colNo) = 0 Then
                        getValOfRowCol = val
                        Exit For
                    End If
                End If
            End If
        Next val
    End If
 
End Function
 
Sub go()
    Dim rel As Integer
     
    '
    rel = setNextValFromRowCol(2, 2)
     
    MsgBox "結果:" & rel
End Sub
 
Function setNextValFromRowCol(fromRow As Integer, fromCol As Integer) As Integer
'OK:0 NG:1
    Dim val As Integer
    Dim NextRow As Integer
    Dim NextCol As Integer
    Dim baseVal As Integer
     
    If fromRow = 11 Then
        MsgBox "OK、完了!"
        End
    End If
     
    If Cells(fromRow, fromCol).Font.Size = 26 Then
        '固有数字
        '次のセルを探す
        'If fromCol = 10 Then
        '    NextRow = fromRow + 1
        '    NextCol = 2
        'Else
        '    NextRow = fromRow
        '    NextCol = fromCol + 1
        'End If
         
        Call getBestRowCol(NextRow, NextCol)
        If NextRow = 0 Then
            MsgBox "完了!"
            End
        End If
         
        If setNextValFromRowCol(NextRow, NextCol) = 0 Then
            setNextValFromRowCol = 0
        Else
            setNextValFromRowCol = 1
        End If
    Else
        '現在値をセットする
        For baseVal = 1 To 9
            val = getValOfRowCol(baseVal, fromRow, fromCol)
            If val <> 0 Then
                Cells(fromRow, fromCol) = val
                             
                '次のセルを探す
                'If fromCol = 10 Then
                '    NextRow = fromRow + 1
                '    NextCol = 2
                'Else
                '    NextRow = fromRow
                '    NextCol = fromCol + 1
                'End If
                 
                Call getBestRowCol(NextRow, NextCol)
                If NextRow = 0 Then
                    MsgBox "完了!"
                    End
                End If
                 
                If setNextValFromRowCol(NextRow, NextCol) = 1 Then
                    Cells(fromRow, fromCol) = ""
                    setNextValFromRowCol = 1
                End If
                baseVal = val
            Else
                setNextValFromRowCol = 1
                Exit For
            End If
        Next baseVal
 
    End If
     
     
End Function
 
 
'行合理性チェック(0:OK, 1:NG)
Function checkRow(val, rowNo)
    Dim col As Integer
    Dim flg As Integer
     
    flg = 0
    For col = 2 To 10
        If val = Cells(rowNo, col) Then
            flg = 1
        End If
        If flg = 1 Then Exit For
    Next col
     
    checkRow = flg
     
End Function
 
'列合理性チェック(0:OK, 1:NG)
Function checkCol(val, colNo)
    Dim row As Integer
    Dim flg As Integer
     
    flg = 0
    For row = 2 To 10
        If val = Cells(row, colNo) Then
            flg = 1
        End If
        If flg = 1 Then Exit For
    Next row
     
    checkCol = flg
     
End Function
 
'BLOCK合理性チェック(0:OK, 1:NG)
Function checkBlock(val, rowNo, colNo)
    Dim row As Integer
    Dim col As Integer
    Dim brow As Integer
    Dim bcol As Integer
    Dim flg As Integer
     
    flg = 0
     
    brow = Fix((rowNo - 2) / 3)
    bcol = Fix((colNo - 2) / 3)
         
    If brow < 0 Then brow = 0
    If bcol < 0 Then bcol = 0
     
    For row = 1 To 3
        For col = 1 To 3
            If val = Cells(brow * 3 + row + 1, bcol * 3 + col + 1) Then
                flg = 1
            End If
            If flg = 1 Then Exit For
        Next col
        If flg = 1 Then Exit For
    Next row
         
    checkBlock = flg
     
End Function
 
'最優先するセルを選択
Function getBestRowCol(ByRef retRow As Integer, ByRef retCol As Integer)
 
    Dim row As Integer
    Dim col As Integer
    Dim valSpace As Integer  '空白評価値
    Dim minValSpace As Integer
     
    retRow = 0
    retCol = 0
     
    minValSpace = 9999
     
    For row = 2 To 10
        For col = 2 To 10
            If Cells(row, col) = "" Then
                valSpace = cntspace(row, col)
                If valSpace < minValSpace And valSpace > 0 Then
                    retRow = row
                    retCol = col
                    minValSpace = valSpace
                End If
            End If
        Next col
    Next row
 
End Function
 
 
Function cntspace(row As Integer, col As Integer) As Integer
'セル所在場所の空白数計算
     
    Dim rowSpace As Integer
    Dim colSpace As Integer
    Dim blkSpace As Integer
     
    Dim val As Integer
     
    '所在行数の空白数
    rowSpace = cntRowSpace(row)
    colSpace = cntColSpace(col)
    blkSpace = cntBlkSpace(row, col)
     
    val = rowSpace
    If colSpace < val Then val = colSpace
    If blkSpace < val Then val = blkSpace
     
    cntspace = val
End Function
 
'行空数を計算
Function cntRowSpace(row As Integer) As Integer
     
    Dim col As Integer
    Dim cnt As Integer
     
    cnt = 0
     
    For col = 2 To 10
        If Cells(row, col) = "" Then
            cnt = cnt + 1
        End If
    Next col
     
    cntRowSpace = cnt
     
End Function
 
'列空数を計算
Function cntColSpace(col As Integer) As Integer
     
    Dim row As Integer
    Dim cnt As Integer
     
    cnt = 0
     
    For row = 2 To 10
        If Cells(row, col) = "" Then
            cnt = cnt + 1
        End If
    Next row
     
    cntColSpace = cnt
     
End Function
 
'Block空数を計算
Function cntBlkSpace(row As Integer, col As Integer) As Integer
     
    Dim cnt As Integer
    Dim rblock As Integer
    Dim cblock As Integer
    Dim i As Integer
    Dim j As Integer
     
    cnt = 0
     
    rblock = Fix((row - 2) / 3)
    cblock = Fix((col - 2) / 3)
     
    For i = 1 To 3
        For j = 1 To 3
            If Cells(rblock * 3 + i + 1, cblock * 3 + j + 1) = "" Then
                cnt = cnt + 1
            End If
        Next j
    Next i
     
    cntBlkSpace = cnt
     
End Function

 

支付宝打赏 微信打赏
分享到 :