苗字でHigh and Low
最近、苗字ランキングがマイナーブームになっているっぽいです。
で、バイト先でその話をしていてちょっとした遊びを思いつきました。
苗字が順に表示されて、前の苗字よりメジャーだと思ったらHighを、マイナーだと思ったらlを選ぶ。で、何連続で当てられるかを勝負するゲーム。
想像以上に面白かったです。
「○○って、そんな苗字の奴いるのかよ!!」
とかツッコミを入れながらやります。
そのExcelのマクロを続きに書いておきます。
1列目に苗字、3列目に人数が書いてあるような表を1つ目のシートにある状態で実行してください。
Sub HighandLow()
Dim c, p, n As Integer
Dim ok As Boolean
Randomize
p = Rnd() * 15000 + 2
c = 100
ok = True
Dim res As String
Do
renn:
n = Rnd() * 15000 + 2
DoEvents
If (Sheet1.Cells(p, 3) / 2 < Sheet1.Cells(n, 3)) And _
(Sheet1.Cells(p, 3) * 2 > Sheet1.Cells(n, 3)) Then _
GoTo renn
rei:
ui = InputBox(res & vbNewLine & "現在" & c & "点です。" & _
vbNewLine & vbNewLine & Sheet1.Cells(p, 1) & "より," & _
Sheet1.Cells(n, 1) & "は")
If (ui = "h") Then
ok = (Sheet1.Cells(p, 3) <= Sheet1.Cells(n, 3))
ElseIf ui = "l" Then
ok = (Sheet1.Cells(p, 3) >= Sheet1.Cells(n, 3))
Else
GoTo rei
End If
res = Sheet1.Cells(p, 1) & ":" & Sheet1.Cells(p, 3) & "人" & _
vbNewLine & Sheet1.Cells(n, 1) & ":" & Sheet1.Cells(n, 3) & _
"人" & vbNewLine
p = n
If ok Then c = c * 2 Else Exit Do
Loop
MsgBox res & vbNewLine & "ゲームオーバーです。" & c & "点"
End Sub