Игры в EXCEL. Быки и коровы

Несколько лет назад у меня появилось увлечение, в то время когда я работал офисным планктоном, мне было интересно взломать систему: сыграть в игры на работе, и сыграть именно в Excel, то есть по сути взлом случился по двум направлениям. В первую очередь игрушки на работе запрещены, а кроме того блокируются все порты и сайты, так что даже не принести их на флешке и не сыграть онлайн. Конечно при должном желании можно найти обход этим блокировкам, но такое мне было не интересно, у меня появилась идея играть в экселе. Стало просто напросто интересно, можно ли придумать игры  в Excel. Как выяснилось такое практикуют уже давно, правда база игр была небольшой, ну и плюс ко всему хотелось сделать что-то именно самому, на примере тех игр, написанных на скриптах vba.

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

Не буду долго распинаться, а просто закину сюда свои игры, и немного напишу как все это создавалось, хотя я и сам забыл уже больше половины того, что там вообще как работает :-)

Первая игра БЫКИ И КОРОВЫ

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

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

Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Value <> "" Then Макрос1
End Sub

для этого нужно щелкнуть правой кнопкой по вкладке листа внизу, там выбрать исходных текст, и в окно добавить такой код. Этот код выполняет Макрос1  в случае если вы щелкаете не по пустой ячейке. Каждый цвет имеет свой код от одного до шести, то есть желтый это 1, а фиолетовый это 6.  Для окрашивания ячеек используется условное форматирование: 6 условий где сравнивается значение ячейки, и если значение равно например 2, то цвет ячейки и шрифта зеленый. 

Сам макрос имеет такой код:

Sub Макрос1()
    sel = Selection.Value
    If Range("B5").Value = "" Then
    Range("B5").Value = sel
    ElseIf Range("C5").Value = "" Then
    Range("C5").Value = sel
      ElseIf Range("D5").Value = "" Then
    Range("D5").Value = sel
    Else
    Range("E5").Value = sel
    End If
    Range("N1").Select
End Sub

То есть по сути он просто копирует значение ячейки в заданные ячейки, если она уже не пустая, то он копирует это значение в следующее,  а потом перекидывает курсор в поле N1 просто чтобы он не мешался.

Новая игра запускает макрос:

Sub NewG()
    Run "Clear"
For i = 7 To 10
Z = Int((6 - 1 + 1) * Rnd + 1)
Cells(3, i).Value = Z
Next
Range("a5").Value = 1
Range("a7:j20").Value = ""
End Sub 

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

Выше загаданная комбинация 5 4 4 2, а первая попытка была 4 4 2 1, то есть вторая четверка на месте, а 4 и 2 угадали наличие, в сумме 120. В этой матрице заложены сложные формулы, которые проверяют сходятся ли цвета, и самое главное нужно было учесть что если цвет один раз подсчитан то он больше не должен учитываться. 

После нажатия на кнопку Проверить, запускается макрос, который проверяет заполнены ли все ячейки, если не заполнены, то он выдает сообщение, и выходит из макроса, если все заполнено, то он проверяет значение выданное формулами, и заполняет серым и черным цветом ячейки. Также копирует всю строку с попыткой, ниже предыдущей попытки, используя значение текущей попытки в номере хода 

Sub Check()
  If Range("E5").Value = "" Then
  MsgBox "Заполните все ячейки"
  Exit Sub
  End If
            Range("G5").Value = ""
            Range("H5").Value = ""
            Range("I5").Value = ""
            Range("J5").Value = ""
   Select Case Range("F4").Value
     Case Is = 100
            Range("G5").Value = 7
      Case Is = 200
            Range("G5").Value = 7
            Range("H5").Value = 7
    Case Is = 300
            Range("G5").Value = 7
            Range("H5").Value = 7
              Range("I5").Value = 7
    Case Is = 400
            Range("G5").Value = 7
            Range("H5").Value = 7
            Range("I5").Value = 7
            Range("J5").Value = 7
    Case Is = 10
            Range("G5").Value = 8
      Case Is = 20
            Range("G5").Value = 8
            Range("H5").Value = 8
    Case Is = 30
            Range("G5").Value = 8
            Range("H5").Value = 8
              Range("I5").Value = 8
    Case Is = 40
            Range("G5").Value = 8
            Range("H5").Value = 8
            Range("I5").Value = 8
            Range("J5").Value = 8
    Case Is = 110
            Range("G5").Value = 7
            Range("H5").Value = 8
    Case Is = 120
            Range("G5").Value = 7
            Range("H5").Value = 8
              Range("I5").Value = 8
    Case Is = 210
            Range("G5").Value = 7
            Range("H5").Value = 7
              Range("I5").Value = 8
    Case Is = 310
            Range("G5").Value = 7
            Range("H5").Value = 7
            Range("I5").Value = 7
            Range("J5").Value = 8
    Case Is = 220
            Range("G5").Value = 7
            Range("H5").Value = 7
            Range("I5").Value = 8
            Range("J5").Value = 8
    Case Is = 130
            Range("G5").Value = 7
            Range("H5").Value = 8
            Range("I5").Value = 8
            Range("J5").Value = 8
      Case Else
            End Select
 
    i = Range("A5").Value + 6
    Cells(i, 1).Value = Range("A5").Value
    Cells(i, 2).Value = Range("B5").Value
    Cells(i, 3).Value = Range("C5").Value
    Cells(i, 4).Value = Range("D5").Value
    Cells(i, 5).Value = Range("E5").Value
    Cells(i, 7).Value = Range("G5").Value
    Cells(i, 8).Value = Range("H5").Value
    Cells(i, 9).Value = Range("I5").Value
    Cells(i, 10).Value = Range("J5").Value
    Cells(i, 2).Value = Range("B5").Value
    Range("A5").Value = Range("A5").Value + 1
 
   If Range("S11").Value = 400 Then
   Range("A5").Value = Range("A5").Value - 1
   Range("B3").Value = Range("G3").Value
   Range("C3").Value = Range("H3").Value
   Range("D3").Value = Range("I3").Value
   Range("E3").Value = Range("J3").Value
 
   MsgBox "Вы угадали последовательность за " & Range("A5").Value & " ходов", , "Уррра!"
   Run "NewG"
   End If
    Range("B5").Value = ""
    Range("C5").Value = ""
    Range("D5").Value = ""
    Range("E5").Value = ""
    Range("G5").Value = ""
    Range("H5").Value = ""
    Range("I5").Value = ""
    Range("J5").Value = ""
End Sub

Скачать игру можно тут.