Еще 2 головоломки в Экселе

И снова пока идет пруха, придумал еще 2 головоломки в Excel, так как нашел наиболее оптимальный способ по управлению ячейками. Простой алгоритм построения головоломок выглядит так:

1 . В рабочем поле нужно сделать условное форматирование ячеек, и менять цвет ячеек и текста в зависимости он значения ячейки

2 . Дальше нужно сделать так чтобы значения ячеек (и соответственно их цвет) менялись при клике на ячейку, для этого лучше всего добавить такой код в рабочий лист

Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Value = "2" Then
цвет1
ElseIf Target.Value = "1" Then
цвет2
Else
'Range("D12").Select
End If
End Sub


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
End Sub

Эти коды выполняют макросы при выделении левой или правой кнопкой мыши ячеек на листе, если значение этой ячейки равно 2 или 1. В первом кокоманда  On Error Resume Next делается для того чтобы макрос не выдвал ошибку при выделении нескольких ячеек. Наверняка можно придумать и более изящный способ, но пока я дошел только до этого.

3. В этих макросах значение выделяемой ячейки нужно менять на другое, в соответствие с желаемым условием. Например в спичках нужно их занулить, чтобы убрать, а в квадрате значение менять 2 на 1, а 1 на 2. Пример макроса по замене цветов на противоположные:

Sub цвет1()
Worksheets("Game").Unprotect Password:="123"
Selection.Value = "1"
If ActiveCell.Offset(0, -1).Value = 1 Then
ActiveCell.Offset(0, -1).Value = "2"
Else
ActiveCell.Offset(0, -1).Value = "1"
End If
Range("H12").Select
If Range("D12").Value = 24 Or Range("D12").Value = 48 Then
MsgBox "Победа!"
Run "новаяигра"
End If
Worksheets("Game").Protect Password:="123"
End Sub

В этом макросе Excel происходит сначала разблокировка листа, для того чтобы макрос мог вносить изменения в защищенные ячейки (ячейки которые меняет макрос могу оказаться за пределами рабочего поля, и для того чтобы вне поля пользователь не щелкал лишний раз, эти ячейки защищены паролем). Дальше мы меняем цвет ячейки по которой мы кликнули на другой, а также рядом цвета в соседних ячейках (в коде выше та что ниже активной ячейки, потому что смещение offset(0,-1) ). По аналогии такой же код для той что сверху, справа и слева. Дальше идет проверка на то заполненно ли все поле одним цветом — там просто суммируется все значения ячеек в поле, и если сумма 24 или 48, то все поле заполненно одним цветом, а следовательно у нас победа, выдается сообщение, и запускается макрос новая игра, который в рандомном порядке заполняет поле цветами. В конце лист снова блокируется.

4. В принципе новую игру игру можно было бы вставить в тот же макрос, там всего лишь такой код:

For i = 2 To 7
For j = 2 To 5
Z = Int((2 - 1 + 1) * Rnd + 1)
Cells(i, j).Value = Z
Next
Next

В каждую ячейку поля добавляется случайное число от 1 до 2 (чтобы сделать до 5, например, то нужно 2 в формуле Z поменять на 5)

5. В спичках компьютер должен убирать определенное число спичек, чтобы выиграть, поэтому там есть еще макрос который проверяет остаток спичек и в соответствии с этим убирает нужно число спичек.

6. Для того чтобы ограничить поле, ячейки все которое после поля, выделяются и делаются шириной 0, и высотой 0. также в параметрах Excel снимаются галочки для этого документа чтобы убрать полосы прокрутки, названия листа и заголовки строк и столбцов, чисто эстетически чтобы лучше смотрелось и небыло ничего лишнего.

Ну а так на этом можно закончить описание игр. Сами игры-головоломки можно скачать тут же. Пароль для снятия защиты листа 123. В них вы можете посмотреть все коды. Спасибо за внимание)

Скачать эти и другие головоломки и игры, можно из этого поста https://boolkin.blogspot.com/2017/11/excel-games.html

Макрос для спичек, конструкция Case
Sub ходкомпа()
If Range(«K5») = 1 Then
MsgBox «Вы победили! :)», , «Поздравляем!»
Application.Run «новая»
Exit Sub
End If
If Range(«A15») = 0 Then
MsgBox «Сначала возьмите спички сами», , «Внимание!»
Exit Sub
End If
Select Case Range(«K5″).Value
Case Is = 14
Z = 1
Case Is = 12
Z = 3
Case Is = 11
Z = 2
Case Is = 10
Z = 1
Case Is = 8
Z = 3
Case Is = 7
Z = 2
Case Is = 6
Z = 1
Case Is = 4
Z = 3
Case Is = 3
Z = 2
Case Is = 2
Z = 1
Case Else
Z = Int((3 — 1 + 1) * Rnd + 1)
End Select
For i = 1 To Z
Cells.Find(What:=»2», After:Оlls(2, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:ъlse _
, SearchFormat:ъlse).Value = «»
Cells.Find(What:=»1″, After:Оlls(3, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:ъlse _
, SearchFormat:ъlse).Value = «»
Range(«T15»).Value = Range(«T15»).Value + 1
Next
Range(«A15»).Value = «0»