[VBA,マクロ]ダーツ(クリケット)のエクセルシート

日記

ダーツのクリケットのエクセルシートを作成しました。

無料アプリでは人数制限があって使いづらいなどと考えている人、
マクロの勉強をし始めて参考にしたい人におすすめの記事となっています。

以下、シートのマクロを参考にしたいというVBA初心者向けに記載していきます。
作成者の私も一週間程度の超初心者のため、間違い、汚いコードを多めに見てください。

構成

ゲームスタート

人数とラウンドを把握しています。
プレイヤーの色も変化させています。

Sub ゲームスタート()

Dim i ‘プレイヤー人数把握のための変数
Dim j ‘プレイヤーの色を変更するための変数
Dim cnt ‘プレイヤー番号
cnt = 1

For i = 5 To 4 + Range(“A2”).Value ‘プレイヤー人数の把握
Cells(3, i) = “Player” & cnt ‘プレイヤー人数の表記
cnt = cnt + 1
Next

Cells(1, 4) = “1” ‘ラウンド数の表記

‘色を黒に戻す
For j = 5 To Range(“E3”).End(xlToRight).Column
Cells(3, j).Font.Color = RGB(1, 0, 0)
Next j

‘Player1の色を赤にする
Cells(3, 5).Font.Color = RGB(255, 0, 0)

Cells(13, 1).Value = “1” ‘プレイヤーの把握

End Sub

プレイヤーチェンジ

プレーヤーNoを把握しつつ、色を変えたり、ラウンド数を加算しています。トータルラウンドが終了すると、「ゲーム終了」のメッセージがでます。

Sub プレイヤーチェンジ()

Dim k
Dim i

‘プレイヤーNoの把握。ボタンを押しただけkの値をたす。
k = Cells(13, 1).Value
k = Cells(13, 1).Value + 1
Cells(13, 1).Value = k

‘色を黒に戻す
For i = 5 To Range(“E3”).End(xlToRight).Column
Cells(3, i).Font.Color = RGB(1, 0, 0)
Next i

‘プレイヤーの色を赤にする
Cells(3, k + 4).Font.Color = RGB(255, 0, 0)

‘kの値がプレイヤー人数になったら1に戻す
If k = Cells(2, 1).Value + 1 Then
Cells(13, 1) = “1”
Range(“E3”).Font.Color = RGB(255, 0, 0)
Cells(1, 4) = Cells(1, 4) + 1 ‘ラウンド数数
End If

‘ゲーム終了のお知らせ
If Cells(1, 4) > Cells(5, 1) Then
MsgBox (“ゲーム終了”)
End If

End Sub

得点(Singe)

Singleは3本とっている場合のみ、点数が入るようになっています。これを20点、19点~~15点、BULLと作製します。点数によってセルが変化してるので注意です。

Sub single20()

Dim i
Dim PlayerNo
Dim PlayerSum

PlayerNo = Cells(13, 1).Value
PlayerSum = Cells(2, 1).Value

‘自分が●なら、●以外に点数ダメージ
If Cells(4, PlayerNo + 4) = “●” Then

For i = 5 To PlayerSum + 4
If Not Cells(4, i) = “●” Then ‘(点数番号の行数,i)
Cells(13, i) = Cells(13, i) + 20
Else
End If
Next

End If

‘×→●
If Cells(4, PlayerNo + 4) = “×” Then ‘(点数番号の行数,)
Cells(4, PlayerNo + 4) = “●”
End If

‘/→×
If Cells(4, PlayerNo + 4) = “/” Then ‘(点数番号の行数,)
Cells(4, PlayerNo + 4) = “×”
End If

‘空白→/
If Cells(4, PlayerNo + 4) = “” Then ‘(点数番号の行数,)
Cells(4, PlayerNo + 4) = “/”
End If

End Sub

得点(Double)

Singleと異なる点は、Double,Tripleの得点は、相手に得点を与える部分が増えます。したがって、IFの中にForが入ってくるとことが2つになっています。

Sub double19()

Dim i
Dim PlayerNo
Dim PlayerSum

PlayerNo = Cells(13, 1).Value
PlayerSum = Cells(2, 1).Value

‘自分が●なら、●以外に点数ダメージ
If Cells(5, PlayerNo + 4) = “●” Then ‘(点数番号の行数,i)

For i = 5 To PlayerSum + 4
If Not Cells(5, i) = “●” Then ‘(点数番号の行数,i)
Cells(13, i) = Cells(13, i) + 38 ‘点数
Else
End If
Next

End If

‘×→●
If Cells(5, PlayerNo + 4) = “×” Then ‘(点数番号の行数,)
Cells(5, PlayerNo + 4) = “●” ‘(点数番号の行数,i)

For i = 5 To PlayerSum + 4
If Not Cells(5, i) = “●” Then ‘(点数番号の行数,i)
Cells(13, i) = Cells(13, i) + 19 ‘点数
Else
End If
Next ‘点数
End If

‘/→●
If Cells(5, PlayerNo + 4) = “/” Then ‘(点数番号の行数,)
Cells(5, PlayerNo + 4) = “●” ‘(点数番号の行数,)
End If

‘空白→×
If Cells(5, PlayerNo + 4) = “” Then ‘(点数番号の行数,)
Cells(5, PlayerNo + 4) = “×” ‘(点数番号の行数,)
End If

End Sub

得点(Triple)

Sub triple18()

Dim i
Dim PlayerNo
Dim PlayerSum

PlayerNo = Cells(13, 1).Value
PlayerSum = Cells(2, 1).Value

‘自分が●なら、●以外に点数ダメージ
If Cells(6, PlayerNo + 4) = “●” Then

For i = 5 To PlayerSum + 4
If Not Cells(6, i) = “●” Then ‘(点数番号の行数,i)
Cells(13, i) = Cells(13, i) + 54 ‘点数
Else
End If
Next

End If

‘×→●
If Cells(6, PlayerNo + 4) = “×” Then ‘(点数番号の行数,)
Cells(6, PlayerNo + 4) = “●”

For i = 5 To PlayerSum + 4
If Not Cells(6, i) = “●” Then ‘(点数番号の行数,i)
Cells(13, i) = Cells(13, i) + 36 ‘点数
Else
End If
Next ‘点数
End If

‘/→●
If Cells(6, PlayerNo + 4) = “/” Then ‘(点数番号の行数,)
Cells(6, PlayerNo + 4) = “●”
For i = 5 To PlayerSum + 4
If Not Cells(6, i) = “●” Then ‘(点数番号の行数,i)
Cells(13, i) = Cells(13, i) + 18 ‘点数
Else
End If
Next
Cells(6, PlayerNo + 4) = “●” ‘(点数番号の行数,)
End If

‘空白→●
If Cells(6, PlayerNo + 4) = “” Then ‘(点数番号の行数,)
Cells(6, PlayerNo + 4) = “●” ‘(点数番号の行数,)
End If

End Sub

リセット

ゲーム終了時に得点やプレイヤーを消去してくれます。

Sub リセット()

Dim i
Dim lastcolum

lastcolum = Range(“E3”).End(xlToRight).Column ‘最終行の取得

‘Cells(2, 1).ClearContents ‘プレイヤー人数の消去
‘Cells(5, 1).ClearContents ‘選択ラウンドの消去
Cells(1, 4).ClearContents ‘計算ラウンドの消去

For i = 5 To lastcolum
Cells(3, i).ClearContents ‘プレイヤーNoの消去
Cells(13, i).ClearContents ‘点数の消去
Range(Range(“E4”), Cells(10, lastcolum)).ClearContents ‘●、×の消去
Next i

End Sub

まとめ

参考になればうれしいです。

コメント

タイトルとURLをコピーしました