時間かかって仕方ない。
暫定でエースを11にしてしまっているが、バーストしそうなときにエースから10をマイナスするのが厄介だ。
Sub BlackJack()
Dim card(52) As Integer
Dim i As Integer
Dim j As Integer
Dim temp As Integer
Dim player(7) As Integer
Dim dealer(7) As Integer
Dim playertotal As Integer
Dim dealertotal As Integer
Dim playerstop As Integer
Dim dealerstop As Integer
total = 0
'トランプの生成、1デッキ52枚
For i = 1 To 52
card(i) = i
Next
'混ぜる。最初のカードをtempという箱に待避
For i = 1 To 52
j = Int(Rnd() * 52) + 1
temp = card(i)
card(i) = card(j)
card(j) = temp
Next
Cells(1, 1) = "=ブラックジャック="
Cells(2, 1) = "プレイヤー"
Cells(10, 1) = "ディーラー"
'プレイヤーのプレイ
For i = 3 To 4
player(i) = Henkan(i, card(i))
Next
playertotal = player(3) + player(4)
'プレイヤーのブラックジャック?または17以上?
If playertotal = 21 Then
Cells(5, 1) = "ブラックジャック!勝てば2.5倍!"
playerstop = 1
End If
If playertotal > 16 And playertotal < 21 Then
playerstop = 1
Cells(5, 1) = "17ストップ!"
Else
If playertotal < 21 Then
playerstop = 0
Cells(5, 1) = ""
End If
End If
'2枚引いた時点の合計
Cells(2, 2) = "合計は"
Cells(2, 3) = playertotal
'ディーラーの1枚目、11枚目から
dealer(1) = Henkan(11, card(i))
Cells(10, 2) = "合計は"
Cells(10, 3) = dealer(1)
'ディーラーの1枚目を見てプレイヤーの判断
If playerstop = 0 And dealer(1) < 7 And dealer(1) <> 1 And playertotal > 11 Then
Cells(6, 1) = "ディーラーバーストに期待!"
playerstop = 1
Else
Cells(6, 1) = ""
End If
'プレイヤーバーストか?17以上まで引く
'ディーラーの2枚目以降、16以下は機械的にめくる
'ディーラーバーストか?
'ショーダウン
'結果によるチップの増減
End Sub
'======================================
'連番Cardをマークに付与するプロシージャー(サブルーチン)
'======================================
Function Henkan(order, card)
Select Case card
Case Is <= 13
Cells(order, 1) = "スペードの"
Cells(order, 2) = card
If card > 10 Then
Henkan = 10
Else
If card = 1 Then
Henkan = 11
Else
Henkan = card
End If
End If
Case Is <= 26
card = card - 13
Cells(order, 1) = "ハートの"
Cells(order, 2) = card
If card > 10 Then
Henkan = 10
Else
If card = 1 Then
Henkan = 11
Else
Henkan = card
End If
End If
Case Is <= 39
card = card - 26
Cells(order, 1) = "ダイヤの"
Cells(order, 2) = card
If card > 10 Then
Henkan = 10
Else
If card = 1 Then
Henkan = 11
Else
Henkan = card
End If
End If
Case Else
card = card - 39
Cells(order, 1) = "クローバーの"
Cells(order, 2) = card
If card > 10 Then
Henkan = 10
Else
If card = 1 Then
Henkan = 11
Else
Henkan = card
End If
End If
End Select
End Function