Ход решения

1. Заполняем ячейки.

2. При нажатии на «Шаг» программа заполнит примечания клеток и раскрасит клетки с однозначным решением на этом шаге.

Если выставить флажки программа расставит цифры и вообще может решить судоку за несколько шагов.

Текст программы

Лист1:

Private Sub CheckBox3_Click()

'для решения судоку с автоматическим

'продолжением шагов и заполнения

'устанавливаются флажки

If CheckBox3.Value = True Then

CheckBox1.Value = True

CheckBox2.Value = True

Else

End If

End Sub

Private Sub CommandButton1_Click()

If CheckBox3.Value = True Then

CheckBox1.Value = True

CheckBox2.Value = True

Else

End If

Call Шаг

End Sub

Module1:

Public текст As String * 9

Public Sub Шаг()

заполнено = 0 'для определения окончания заполнения

авто_шаг = 0 'для выхода из цикла, если за 10 шагов судоку не заполнено

While заполнено < 81

заполнено = 0

авто_шаг = авто_шаг + 1

For s = 2 To 10 '

For k = 2 To 10 '

Cells(s, k).Activate

Call Не_выдеять '

If Cells(s, k) >= 1 Then

текст = "_________" '

заполнено = заполнено + 1

Else

текст = "123456789" '

Call В_строке(s) 'замена цифры на "_" если такая есть в строке

Call В_колонке(k) 'замена цифры на "_" если такая есть в колонке

Call В_квадрате(s, k) 'замена цифры на "_" если такая есть в блоке 3х3

Call Единственная(s, k) 'если для клетки это единственный вариант - заполнить

End If

Call Примечание(s, k) 'изменение текста примечания

Next k

Next s

Call Место 'этой цифры нет в вариантах других клеток строка, колонка, квадрат)

If Sheets(1).CheckBox3.Value = False Then

заполнено = 81 ' для предотвращения АвтоШага

Else

End If

If авто_шаг > 10 Then

заполнено = 81 ' для предотвращения зацикливания

Else

End If

Wend

End Sub

Public Sub Примечание(строка, колонка)

If текст = "_________" Then

'удаление примечания

Cells(строка, колонка).Activate

Selection.ClearComments

Else

If Cells(строка, колонка).Comment Is Nothing Then

'создание примечания и запись текста

Cells(строка, колонка).AddComment

Cells(строка, колонка).Comment.Visible = False

Cells(строка, колонка).Comment.Text Text:=текст

'размеры

Cells(строка, колонка).Comment.Shape.ScaleWidth 0.5, msoFalse, msoScaleFromTopLeft

Cells(строка, колонка).Comment.Shape.ScaleHeight 0.2, msoFalse, msoScaleFromTopLeft

Else 'изменение текста примечания

Cells(строка, колонка).Comment.Text Text:=текст

End If

End Sub

Public Sub В_строке(строка)

For k = 2 To 10

If Cells(строка, k) >= 1 Then

'по цифре в клетке опредеяем место символа в примечании для замены

Mid(текст, Cells(строка, k), 1) = "_"

Else

End If

Next k

End Sub

Public Sub В_колонке(колонка)

For s = 2 To 10

If Cells(s, колонка) >= 1 Then

'по цифре в клетке опредеяем место символа в примечании для замены

Mid(текст, Cells(s, колонка), 1) = "_"

Else

End If

Next s

End Sub

Public Sub В_квадрате(строка, колонка)

строка_0 = строка - (строка + 1) Mod 3

колонка_0 = колонка - (колонка + 1) Mod 3

For s = строка_0 To строка_0 + 2

For k = колонка_0 To колонка_0 + 2

If Cells(s, k) >= 1 Then

'по цифре в клетке опредеяем место символа в примечании для замены

Mid(текст, Cells(s, k), 1) = "_"

Else

End If

Next k

Next s

End Sub

Public Sub Единственная(s, k)

цифр = 0 'для посчета количества цифр в примечании

For i = 1 To 9

If Mid(текст, i, 1) <> "_" Then

t = i

цифр = цифр + 1

End If

Next i

If цифр = 1 Then

If Sheets(1).CheckBox1.Value = True Then

Cells(s, k).Value = t

Else

End If

Call Выделить(5296274) 'зелёный

End If

End Sub

Public Sub Место()

For s = 2 To 10

For k = 2 To 10

If Cells(s, k).Comment Is Nothing Then

Else

Cells(s, k).Activate

If Selection.Interior.Color = 5296274 Then

Else

Одна_из = Cells(s, k).Comment.Text

For цифра = 1 To 9

Call Одна_в_строке(s, k, Mid(Одна_из, цифра, 1), цифра)

Call Одна_в_колонке(s, k, Mid(Одна_из, цифра, 1), цифра)

Call Одна_в_квадрате(s, k, Mid(Одна_из, цифра, 1), цифра)

Next цифра

End If

Next k

Next s

End Sub

Public Sub Выделить(Color_)

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.Color = Color_ '65535 или 5296274

.TintAndShade = 0

.PatternTintAndShade = 0

End With

End Sub

Public Sub Не_выдеять()

With Selection.Interior

.Pattern = xlNone

.TintAndShade = 0

.PatternTintAndShade = 0

End With

End Sub

Public Sub Одна_в_строке(s, k, символ, цифра)

If символ = "_" Then

Exit Sub

Else

куча = 0

For k1 = 2 To 10

If Cells(s, k1).Comment Is Nothing Then

Else

i = InStr(Cells(s, k1).Comment.Text, символ)

If i > 0 Then

куча = куча + 1

Else

i = i

End If

Next k1

If куча = 1 Then

Cells(s, k).Activate

If Sheets(1).CheckBox2.Value = True Then

Cells(s, k) = цифра

Else

End If

Call Выделить(65535) 'желтый

куча = 0

End If

End Sub

Public Sub Одна_в_колонке(s, k, символ, цифра)

If символ = "_" Then

Exit Sub

Else

куча = 0

For s1 = 2 To 10

If Cells(s1, k).Comment Is Nothing Then

Else

If InStr(символ, Cells(s1, k).Comment.Text) Then

куча = куча + 1

End If

Next s1

If куча = 1 Then

Cells(s, k).Activate

If Sheets(1).CheckBox2.Value = True Then

Cells(s, k) = цифра

Else

End If

Call Выделить(65535) 'желтый

End If

End Sub

Public Sub Одна_в_квадрате(s, k, символ, цифра)

If символ = "_" Then

Exit Sub

Else

строка_0 = s - (s + 1) Mod 3

колонка_0 = k - (k + 1) Mod 3

куча = 0

For s1 = строка_0 To строка_0 + 2

For k1 = колонка_0 To колонка_0 + 2

If Cells(s1, k1).Comment Is Nothing Then

Else

If InStr(символ, Cells(s1, k1).Comment.Text) Then

куча = куча + 1

End If

Next k1

Next s1

If куча = 1 Then

Cells(s, k).Activate

If Sheets(1).CheckBox2.Value = True Then

Cells(s, k) = цифра

Else

End If

Call Выделить(65535) 'желтый

End If

End Sub

Удачи.

Лист Excel

Ход решения

Текст программы