用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