上級95回のコード

宣言

#If Win64 Then
   Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
   Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
'↑noteからコピペすると上手く貼りつかないかもです。
Public wsGame As Worksheet
Public gameFG As Boolean
Public tekiX As Integer
Public tekiY As Integer
Public uAct As Long
Public numX As Integer
Public numY As Integer
Public tekiWait As Integer
Public count As Long
Public cNum As Integer
Public point As Integer
Const MaxNum As Integer = 50
Const TekiWaitDef As Integer = 2

スタート

Sub start()
   If Not gameFG Then
       gameFG = True
       Call init
       DoEvents
       
       wsGame.Range("d11") = "数字探しで勝負だ！"
       Sleep 2000
       DoEvents
       
       tekiWait = TekiWaitDef
       count = 0
       point = 0
       cNum = 1
       wsGame.Range("d11") = "最初は「" & cNum & "」" & "だな・・・"
       Call serchNum(cNum)
       Call game
   End If
End Sub

イニット

Sub init()
   Dim nums(1 To 50) As Integer
   
   Dim i As Integer
   Dim j As Integer
   Dim c As Integer
   Dim r As Integer
   Dim x As Integer
   
   
   
   Set wsGame = ThisWorkbook.Worksheets("game")
   
   tekiX = 9
   tekiY = 0
   
   wsGame.Range("c5:l9").Interior.Color = RGB(0, 0, 0)
   
   uAct = RGB(40, 40, 100)
   wsGame.Range("c5").Offset(tekiY, tekiX).Interior.Color = uAct
   
   For i = 1 To MaxNum
   
       nums(i) = i
   
   Next i
   
   Randomize
   
   c = 0
   
   
   '数字をランダムに配置する処理
   For j = 0 To 4
   
       For i = 0 To 9
       
           r = Int((50 - c) * Rnd + 1)
           
           If nums(r) = 0 Then
               wsGame.Range("C5").Offset(j, i) = ""
           Else
               wsGame.Range("C5").Offset(j, i) = nums(r)
           End If
           
           For x = r To 49
               nums(x) = nums(x + 1)
           Next x
           
           c = c + 1
           
       Next i
       
   Next j
   
   wsGame.Range("b11") = point
   wsGame.Range("a1").Select
   
End Sub

ゲーム

Sub game()
   Do While gameFG
   
       If tekiWait = 0 Then
           tekiMove
       Else
           tekiWait = tekiWait - 1
       End If
       
       DoEvents
       
       If cNum > MaxNum / 2 Then
       
           Sleep 150
       Else
           Sleep 300
       End If
       
       count = count + 1
   Loop
End Sub

プッシュナム

Sub pushNum(Target)
   If wsGame.Range("c5").Offset(numY, numX) = Target Then
       Target = ""
       point = point + 1
       wsGame.Range("b11") = point
       Call numChange
   End If
End Sub

ナムチェンジ

Sub numChange()
   If cNum = MaxNum Then
       gameFG = False
       wsGame.Range("d11") = "おわりか・・・"
       
       DoEvents
       Sleep 1000
       
       If point = MaxNum Then
           wsGame.Range("d11") = "パーフェクトだと！？御見それしました先生"
       ElseIf point > MaxNum / 2 Then
           wsGame.Range("d11") = "ん？俺の方が少ないだと！？負けた・・・"
       Else
           wsGame.Range("d11") = "全然とれてないな。出直してこい"
       End If
   Else
       If cNum = MaxNum / 2 Then
           wsGame.Range("d11") = "ちょっとだけ本気をだすか・・・"
           DoEvents
           Sleep 1000
       End If
       
       cNum = cNum + 1
       tekiWait = TekiWaitDef
       Call serchNum(cNum)
       wsGame.Range("d11") = "次は「" & cNum & "」" & "だな・・・"
   End If
End Sub

テキムーブ

Sub tekiMove()
   wsGame.Range("c5").Offset(tekiY, tekiX).Interior.Color = vbBlack
   
   If tekiX > numX Then
       tekiX = tekiX - 1
   ElseIf tekiX < numX Then
       tekiX = tekiX + 1
   ElseIf tekiY > numY Then
       tekiY = tekiY - 1
   ElseIf tekiY < numY Then
       tekiY = tekiY + 1
   Else
       wsGame.Range("c5").Offset(tekiY, tekiX) = ""
       Call numChange
   End If
   
   wsGame.Range("c5").Offset(tekiY, tekiX).Interior.Color = uAct
   
End Sub

サーチナム

Sub serchNum(num)
   Dim r As Integer
   Dim c As Integer
   
   
   For r = 0 To 4
       For c = 0 To 9
           If wsGame.Range("c5").Offset(r, c) = num Then
               numX = c
               numY = r
               Exit Sub
           End If
       Next c
   Next r
   
   
End Sub

セレクションチェンジ

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If gameFG Then
   
       If Target.Row >= 5 And Target.Row <= 9 Then
          If Target.Column >= 3 And Target.Column <= 13 Then
       
               Call pushNum(Target)
           End If
       End If
       
       wsGame.Range("a1").Select
   End If
End Sub