用EXCEL解数独

概述用EXCEL解数独

下面是内存溢出 jb51.cc 通过网络收集整理的代码片段。

内存溢出小编现在分享给大家，也给大家做个参考。

Rem Attribute VBA_ModuleType=VBAModuleOption VBASupport 1Option 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 IfEnd FunctionSub go()    Dim rel As Integer        '    rel = setNextValFromrowCol(2,2)        MsgBox "結果：" & relEnd SubFunction 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,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 rowEnd FunctionFunction 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 = valEnd 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

以上是内存溢出(jb51.cc)为你收集整理的全部代码内容，希望文章能够帮你解决所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。

总结

以上是内存溢出为你收集整理的用EXCEL解数独全部内容，希望文章能够帮你解决用EXCEL解数独所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。