苗字で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