【VBA】タイマーとランキング表示が上手くいきません。 1～5までの数値を順に右クリックし、タイムをランキング形式で記録するカウントアップゲームを作成しています。ゲーム自体は実行できるのですが、下記の問題が発生しています。 ・タイマーが止まらない タイマーはDo While~Loop文によって実装しています。しかし、ElseIf文にてゲームをクリアした場合に「StopFlg = True」と書いてもLoopが終了しません。 ・ランキングが2位のセルまでしか表示されない 3回目以降の記録が全て2位のセルに表示されてしまいます。原因は、2回目以降に処理されるElse文のiが13のまま変わらないためであると考えられます。ゲームを実行する度にiを1増やしたいのですが、「i = 13」が毎回実行されてしまうため更新できません。しかしこの情報は必要です。変数の値を保持するStaticで宣言してみたのですが、効果はありませんでした。 具体的なプログラムも回答していただければ非常にありがたいです。よろしくお願いいたします。以下にプログラムを記載します。 Sub CountupGame() Dim g As Integer Dim r As Integer Dim n As Integer Static i As Integer Dim StartTimer As Double Dim StopFlg As Boolean End Sub Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) 'Startセルを右クリックした場合' If Target.Value = Cells(10, 2) Then g = Int((8 - 2 + 1) * Rnd + 2) '行数をランダムに選択（2~8）' r = Int((6 - 2 + 1) * Rnd + 2) '列数をランダム選択（B~F）' Cells(g, r) = 1 'タイマースタート' StopFlg = False StartTimer = Timer Do While StopFlg = False Cells(10, 5) = Int((Timer - StartTimer) * 100) / 100 DoEvents Loop End If '盤面を右クリックした場合' If Target.Value = "" Then MsgBox ("はずれ") ElseIf Target.Value = "5" Then StopFlg = True 'タイマーストップ（Loop終了）' MsgBox ("おめでとうゲーム終了です") Range("B2:F8") = "" '盤面をリセット' 'ランキング' i = 13 If Cells(13, 3) = "" Then '1回目のみ実行' Cells(13, 3) = Cells(10, 5).Value '記録をC13に追加' Cells(13, 4) = "←" '今回の記録であることを示す' Else '2回目以降に実行' Cells(i + 1, 3) = Cells(10, 5).Value '記録を下に追加' Range("D13:D22") = "" '前回の矢印を削除' Cells(i + 1, 4) = "←" End If i = i + 1 '並び替え' Call Range("C13:D22").Sort( _ Key1:=Range("C13"), Order1:=xlAscending) '昇順' ElseIf Target.Value <> "Start" Then '1~4の数値を選択した場合' n = Target.Value 'n = 1~4' g = Int((8 - 2 + 1) * Rnd + 2) r = Int((6 - 2 + 1) * Rnd + 2) Cells(g, r) = n + 1 'n = 2~5' Target.Value = "" '数値があったセルを削除' End If Cancel = True '右クリックのメニュー表示を無効' End Sub
Visual Basic
