微剋多資訊

 找回密碼
 註冊

Sign in with google

Google帳號登入

搜索
回覆 2則 瀏覽 15456篇
Line

解數獨程式(VBA)初級版

該用戶從未簽到

升級   11.29%

跳轉到指定樓層
主題
發表於 2012-9-19 13:00 | 只看該作者 回帖獎勵 |倒序瀏覽 |閱讀模式
本帖最後由 cchh543-md 於 2012-9-19 13:37 編輯

看到市集有免費的數獨可玩,
提供自己寫的解數獨程式(VBA)初級版,
請參考
使用EXCEL,數獨問題放sheet1,程式碼放巨集模組;
不保證全部都能解,簡單的應沒問題

Sub su()
    Dim sh As Sheet1
    Set sh = Sheet1
    For r = 1 To 9
        For c = 1 To 9
            tmp = sh.Cells(r, c)
            If tmp >= 1 And tmp <= 9 Then
            Else
                sh.Cells(r, c) = cal(r, c)
            End If
        Next
    Next
End Sub

Function cal(rp, cp)
    Dim sh As Sheet1
    Set sh = Sheet1
    tmp = ""
    For r = 1 To 9
        shval = sh.Cells(r, cp)
        If shval >= 1 And shval <= 9 Then
            tmp = tmp & shval
        End If
    Next
    For c = 1 To 9
        shval = sh.Cells(rp, c)
        If shval >= 1 And shval <= 9 Then
            tmp = tmp & shval
        End If
    Next
    mrp = rp - ((rp - 1) Mod 3)
    mcp = cp - ((cp - 1) Mod 3)
    For r = mrp To mrp + 2

        For c = mcp To mcp + 2
            shval = sh.Cells(r, c)
            If shval >= 1 And shval <= 9 Then
                tmp = tmp & shval
            End If
        Next
    Next
    tmptrue = ""
    valarr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
    For v = 0 To UBound(valarr)
        fstr = InStr(1, tmp, valarr(v))
        If fstr = 0 Then
            tmptrue = tmptrue & valarr(v) & " "
        End If
    Next
    cal = tmptrue
End Function

開始


求解過程(次數不定)


解答


樓主熱門主題

簽到天數: 23

該用戶今日未簽到

升級   100%

2F
發表於 2012-9-19 13:17 | 只看該作者
可以來個執行狀況的截圖會更好

使用道具

您需要登入後才可以回帖 登入 | 註冊

本版積分規則

小黑屋|Archiver|微剋多資訊(MicroDuo)

GMT+8, 2024-4-24 06:34

Discuz! X

© 2009-2023 Microduo

快速回覆 返回頂部 返回列表