数独Sudoku Round目录

用VBA解数独程序

求excel解4*4和5*5的数独，开始的数字是由用户自己输入，而不是excel随机出现。万分感谢各位！！

excel 公式 随机填入几个数字

用VBA解数独程序

自己之前写的，没有优化，多解的解不了

Sub 解()

Dim i, j, x, y, z As Integer

Dim row, col

Dim kg

Dim pckg, a1, a2, a3

Dim r

t = Timer

For i = 1 To 9

For j = 1 To 9

If Sheet3.Cells(i, j) <> "" Then

Range(Cells(i, j), Cells(i, j)).Select

Selection.Font.Bold = True

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorDark1

.TintAndShade = -0.349986266670736

.PatternTintAndShade = 0

End With

'设置已知表格为灰色、加粗

End If

Next

Next

1: r = 0

For z = 1 To 9 '遍历小九宫

For i = 1 To 3

For j = 1 To 3

pckg = 0

row = i * 3 '小九宫格最后一行

col = j * 3 '小九宫格最后一列

kg = 9 - Application.WorksheetFunction.CountA(Sheet3.Range(Cells(i * 3 - 2, j * 3 - 2), Cells(i * 3, j * 3))) '小九宫格空格数赋予kg

Cells(i + 10, j + 10) = kg

For x = i * 3 - 2 To i * 3

For y = j * 3 - 2 To j * 3

If Sheet3.Cells(x, y) = "" Then '遍历小九宫，如果为空

a1 = Application.WorksheetFunction.CountIf(Sheet3.Range(Cells(row - 2, col - 2), Cells(row, col)), z) '该小九宫是否含该数

a2 = Application.WorksheetFunction.CountIf(Sheet3.Range(Cells(x, 1), Cells(x, 9)), z) '该行是否含该数

a3 = Application.WorksheetFunction.CountIf(Sheet3.Range(Cells(1, y), Cells(9, y)), z) '该列是否含该数

If a1 + a2 + a3 <> 0 Then

pckg = pckg + 1 '排除数加1

Cells(x, y) = 0

End If

End If

Next y

Next x

If kg - pckg = 1 Then

For Each Rng In Range(Cells(row - 2, col - 2), Cells(row, col))

If Rng.Value = "" Then Rng.Value = z

If Rng.Value = "0" Then Rng.Value = ""

Next

r = r + 1

Else

For Each Rng In Range(Cells(row - 2, col - 2), Cells(row, col))

If Rng.Value = "0" Then Rng.Value = ""

Next

End If

Next j

Next i

Next z

2: For z = 1 To 9 '遍历行

For i = 1 To 9

kg = 9 - Application.WorksheetFunction.CountA(Sheet3.Range(Cells(i, 1), Cells(i, 9))) '该行空格数赋予kg

pckg = 0

For j = 1 To 9

If Sheet3.Cells(i, j) = "" Then '遍历行，如果为空

a1 = Application.WorksheetFunction.CountIf(Sheet3.Range(Cells(Round(i / 3 + 0.49, 0) * 3 - 2, Round(j / 3 + 0.49, 0) * 3 - 2), Cells(Round(i / 3 + 0.49, 0) * 3, Round(j / 3 + 0.49, 0) * 3)), z) '该小九宫是否含该数

a2 = Application.WorksheetFunction.CountIf(Sheet3.Range(Cells(i, 1), Cells(i, 9)), z) '该行是否含该数

a3 = Application.WorksheetFunction.CountIf(Sheet3.Range(Cells(1, j), Cells(9, j)), z) '该列是否含该数

If a1 + a2 + a3 <> 0 Then

pckg = pckg + 1 '排除数加1

Cells(i, j) = 0

End If

End If

Next j

If kg - pckg = 1 Then

For Each Rng In Range(Cells(i, 1), Cells(i, 9))

If Rng.Value = "" Then Rng.Value = z

If Rng.Value = "0" Then Rng.Value = ""

Next

r = r + 1

Else

For Each Rng In Range(Cells(i, 1), Cells(i, 9))

If Rng.Value = "0" Then Rng.Value = ""

Next

End If

Next i

Next z

3: For z = 1 To 9 '遍历列

For j = 1 To 9

kg = 9 - Application.WorksheetFunction.CountA(Sheet3.Range(Cells(1, j), Cells(9, j))) '该行空格数赋予kg

pckg = 0

For i = 1 To 9

If Sheet3.Cells(i, j) = "" Then '遍历行，如果为空

a1 = Application.WorksheetFunction.CountIf(Sheet3.Range(Cells(Round(i / 3 + 0.49, 0) * 3 - 2, Round(j / 3 + 0.49, 0) * 3 - 2), Cells(Round(i / 3 + 0.49, 0) * 3, Round(j / 3 + 0.49, 0) * 3)), z) '该小九宫是否含该数

a2 = Application.WorksheetFunction.CountIf(Sheet3.Range(Cells(i, 1), Cells(i, 9)), z) '该行是否含该数

a3 = Application.WorksheetFunction.CountIf(Sheet3.Range(Cells(1, j), Cells(9, j)), z) '该列是否含该数

If a1 + a2 + a3 <> 0 Then

pckg = pckg + 1 '排除数加1

Cells(i, j) = 0

End If

End If

Next i

If kg - pckg = 1 Then

For Each Rng In Range(Cells(1, j), Cells(9, j))

If Rng.Value = "" Then Rng.Value = z

If Rng.Value = "0" Then Rng.Value = ""

Next

r = r + 1

Else

For Each Rng In Range(Cells(1, j), Cells(9, j))

If Rng.Value = "0" Then Rng.Value = ""

Next

End If

Next j

Next z

If Application.WorksheetFunction.CountA(Sheet3.Range("a1:i9")) <> 81 Then

If r = 0 Then

MsgBox "水平不足,无解或多解弄不了，耗时" & Timer - t & "s"

Else

GoTo 1

End If

Else

MsgBox "解题完毕 耗时：" & Timer - t & "s"

End If

End Sub

求excel解4*4和5*5的数独，开始的数字是由用户自己输入，而不是excel随机出现。万分感谢各位！！

需要定义一个函数，比如这个函数名用sswrls（四舍五入留双的拼音，可以任取），打开vba，插入一个模块，复制下面的代码粘贴进去后关闭

Function sswrls(rng As Double, number As Integer) As Double

sswrls = Round(rng, number)

End Function

再回到excel，输入公式，比如 =sswrls(A1，1)

你试试

excel 公式 随机填入几个数字

如果你用的是2003版,这么一个公式试试,A1或任意单元格输入

=ROUNDUP(3*RAND()/100,2)+7.23

自动填充下拉,如果是2007版,这个公式较好,

=RANDBETWEEN(724,726)/100

同样自动填充下拉.