VBA ルーレット 抽選

Question

前提・実現したいこと

・抽選会で使用
・ルーレット
・スタートボタンが押され、ストップボタンを押すと、止まった数字のところだけ色変更。
・全クリアボタンを押すとセルの色が塗りつぶしなしに

発生している問題・エラーメッセージ

エラーメッセージ

該当のソースコード

Sub ルーレット()
Range("B3:T14").Select
With Selection
.Font.Name = "Arial Black"
.Font.Size = 20
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
ActiveWorkbook.Names.Add Name:="table", RefersTo:=Selection
n = 0
For Each c In Range("table")
n = n + 1
c.Value = n
Next
For i = 1 To 2
For Each c In Range("table")
c.Select
For m = 20 To 3 Step -1
Selection.Interior.ColorIndex = m
Next m
Range("table").Interior.ColorIndex = 0
Next c
Next i
Randomize
x = Int(Rnd * 70) + 1
For Each c In Range("table")
c.Select
For m = 20 To 3 Step -1
Selection.Interior.ColorIndex = m
Next m
Range("table").Interior.ColorIndex = 0
If c.Value = x Then
Selection.Interior.ColorIndex = 6
Exit Sub
End If
Next c
End Sub

試したこと

ストップボタンの作成を試みたができなかった

補足情報（FW/ツールのバージョンなど）

ごめんなさい、VBAは全くの知識がなく、初心者です。
ネットで調べたコードをコピペして少しづつ変えていこうと考えていました。
ですが、期限もあと1週間なので、このサイトを頼ることにしました。
言葉足らずと知識不足で申し訳ないですが、ご理解の上、ご回答よろしくお願いします。

Comments

[BeatStar]

せめてインデント(Tabキーや半角スペースでやるアレ)ぐらいは入れようよ…
読ませる気無いように見える…

[uemiy]

すいません、ご迷惑をおかけしました。
補足情報に追記したので、ご理解の上、ご回答よろしくお願いします。

[meg_]

> ですが、期限もあと1週間なので、このサイトを頼ることにしました。
抽選会が1週間後に開催されるのですか？
抽選自体が実装できているのならストップボタンなしでも良いのでは？

[BeatStar]

> ネットで調べたコードをコピペして少しづつ変えて

論外。
料理でいえば『料理をしたことないのに、色気出して余計なことをする』ですね。
初めてやるならレシピ通りにするはずです。
でも『俺は天才だから』とかでレシピを読まずに勝手なことをするのと大差ないです。

まずは基礎からやりましょう。

理解していないものを改造しようとしても十中八九失敗します。

車の構造を理解せずに、何も考えずに分解して再構築するようなものです。

そもそも課題は『答えが合っていること』ではありません。

『自分なりに考え、自分なりに調べること』が目的です。

でも基礎を蔑ろにすると、どんな丁寧な説明でも理解できないはずです。

まずは基礎からやりましょう。

[BeatStar]

それと、まだインデントが変です。

コードを読むと、WithステートメントにWithステートメントが入っています。
入れ子状態ですね。
今の書き方だと読みづらいです。

Answer 1

要するにこれは「ループの実行中にストップボタンを操作したい」ということですかね?
それならDoEventsを使ってください。DoEventsを入れるとそこでボタン等のイベント
を処理してくれるのでループ中でもボタン操作が可能になります。

それを含めてコード書き換えてみました。

Option Explicit

Dim STOPFLAG As Boolean                     ' グローバル

Private Sub CommandButton1_Click()          ' スタートボタン
  STOPFLAG = False
  Call ルーレット
End Sub

Private Sub CommandButton2_Click()          ' ストップボタン
  STOPFLAG = True
End Sub

Sub ルーレット()
  '
  ' 盤面作製
  '
  Dim TA As Range: Set TA = Range("B3:T14")
  TA.Font.Name = "Arial Black"
  TA.Font.Size = 9
  TA.HorizontalAlignment = xlCenter
  TA.VerticalAlignment = xlBottom
   TA.Borders.LineStyle = xlContinuous
  TA.Borders.Weight = xlThin
  TA.Borders.ColorIndex = xlAutomatic
  
  Dim i As Long
  Dim m As Long
  
  i = 0
  Dim c As Range
  For Each c In TA
    i = i + 1
    c.Value = i
  Next
  '
  ' 回転(無限ループ)
  '
  Do While (True)
    For Each c In TA
      DoEvents                              ' 終了ボタンの受け付け
      If (STOPFLAG) Then GoTo LOOPEXIT      ' Break条件
      For i = 1 To 2
        For m = 20 To 3 Step -1
          c.Interior.ColorIndex = m
        Next m
        c.Interior.ColorIndex = 0
      Next i
    Next c
  Loop

LOOPEXIT:
  '
  ' ストップ。当たり作製
  '
  Randomize
  Dim x As Long: x = Int(Rnd * 228) + 1
  For Each c In TA
    For m = 20 To 3 Step -1
      c.Interior.ColorIndex = m
    Next m
    c.Interior.ColorIndex = 0
    If c.Value = x Then
      c.Interior.ColorIndex = 6
      Exit Sub
    End If
  Next c
End Sub

あと、ストップした時の処理ですが…
どのタイミングでストップボタンを押しても駒の流れが1からリスタートするので
見ていて動きがインチキ臭い(笑)。
ストップボタンが押されたら「あと何個マスを進めるか」を乱数で決定し、その個数だけ
進んだところで無限ループを止めて当たりにするようにすれば自然になります。

Answer 2

求めているものと微妙に違うと思いますが。

Option Explicit

Sub 盤面作成()
    Dim c As Range, n As Long
    With Cells
        .Clear
        .Font.Name = "Arial Black"
        .Font.Size = 20
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Columns(1).Font.ColorIndex = 2
    End With
    With Range("B3:T14")
        ActiveWorkbook.Names.Add Name:="table", RefersTo:=.Cells
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        n = 0
        For Each c In .Cells
            n = n + 1
            c.Value = n
        Next
        .FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=$A$1").Interior.ColorIndex = 3
    End With
End Sub

Sub ボタンクリック()
    If Range("A2").Value = 0 Then
        Range("table").FormatConditions(1).Interior.ColorIndex = 3
        Range("A2").Value = 5
        ルーレット回転
        Range("table").FormatConditions(1).Interior.ColorIndex = 4
        Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Value = Range("A1").Value
    Else
        Application.OnTime Now + TimeValue("0:0:1"), "CountDown"
    End If
End Sub

Sub CountDown()
    With Range("A2")
        If .Value = 0 Then Exit Sub
        .Value = .Value - 1
    End With
    Application.OnTime Now + TimeValue("0:0:1"), "CountDown"
End Sub

Sub ルーレット回転()
    Dim i, j, x
    x = WorksheetFunction.Max(Range("table"))
    For i = 1 To WorksheetFunction.RandBetween(500, 1000)
        Range("A1").Value = i Mod x
        If Range("A2").Value = 0 Then Exit For
        For j = 1 To 20 + 10 ^ (5 - Range("A2").Value)
            DoEvents
        Next
    Next
End Sub