vba seminar banner 
    Home   >>   Quiz   >>   Rock Paper Scissors
"じゃんけんゲーム" 
"出力例"
じゃんけんの手(チョキー、パー、グー)を入力させ、コンピュータと対戦させるじゃんけんゲームを作成しろ
rps01
"サンプルマクロ01"
"ヒント・解説01"
Public Function Jrps(p As Variant, c As Variant, _
 wc As Integer, lc As Integer, dc As Integer) As Variant

If p = c Then
    Jrps = Array("引き分け", wc, lc, dc + 1)
ElseIf p = 0 And c = 1 Or p = 1 And c = 2 Or p = 2 And c = 0 Then
    Jrps = Array("勝ち", wc + 1, lc, dc)
Else
    Jrps = Array("負け", wc, lc + 1, dc)
End If

End Function


Public Sub Rps01()

Dim n As Boolean, m As Boolean
Dim i As Integer, j As Integer, nrow As Integer
Dim winc As Integer, losec As Integer, drawc As Integer
Dim res As Variant, player As Variant, com As Variant
Dim h(8) As Variant, s As Variant, t As Variant

n = True: m = True '終了フラグ
s = Array("対戦回数", "1P", "COM", "判定", "Win", "Lose", "Draw", "勝率")
t = Array("チョキ", "パー", "グー")

With Range("A1:H1") '1行目タイトル

    .MergeCells = True
    .Value = "じゃんけんゲーム"
    
End With

For i = 0 To UBound(s) '2行目項目

    Cells(2, i + 1).Value = s(i)

Next i

Do While m = True

    Do While n = True

        player = Application.InputBox("あなたの出す手を入力してください" _
         & vbCr & "  0(チョキ)、1(パー)、2(グー)", "じゃんけんゲーム", "0", Type:=1)
    
        If VarType(player) = vbBoolean Then '0 = False
            MsgBox "キャンセルしました", vbInformation: Exit Sub
        ElseIf player < 0 Or player > 2 Then
            MsgBox "0(チョキ)か、1(パー)か、2(グー)を入力してください"
        Else
            n = False
        End If
        
    Loop
    
    nrow = Range("A1").CurrentRegion.Rows.Count '最終行
    winc = IIf(nrow - 1 = 1, 0, Range("E" & nrow).Value)
    losec = IIf(nrow - 1 = 1, 0, Range("F" & nrow).Value)
    drawc = IIf(nrow - 1 = 1, 0, Range("G" & nrow).Value)
    Randomize: com = Int(3 * Rnd())
    
    h(0) = nrow - 1
    h(1) = t(player)
    h(2) = t(com)
    h(3) = Jrps(player, com, winc, losec, drawc)(0)
    h(4) = Jrps(player, com, winc, losec, drawc)(1)
    h(5) = Jrps(player, com, winc, losec, drawc)(2)
    h(6) = Jrps(player, com, winc, losec, drawc)(3)
    h(7) = h(4) / h(0) * 100
    
    For j = LBound(s) To UBound(s) '各項目の値をセルに代入する
    
        Cells(nrow + 1, j + 1).Value = h(j)
    
    Next j
    
    res = MsgBox("続けて入力しますか?", vbQuestion + vbYesNo)
    
    If res = vbNo Then 'いいえを押すと終了させる
        MsgBox "終了します", vbInformation: m = False
    Else
        n = True
    End If
    
Loop

End Sub	
	
  0-2までの乱数を作成する。