正直、こんなに長くなるとは思わなかった。次からファイル名を変える。
巷ではこういう時Gitというのを使うらしいが、チラと見たら難解な説明文でもう発狂しそうになった。
Sub BlackJack()
Dim card(52) As Integer
Dim i As Integer
Dim j As Integer
Dim temp As Integer
Dim player(9) As Integer
Dim dealer(19) As Integer
Dim playertotal As Integer
Dim dealertotal As Integer
Dim playerstop As Integer
Dim dealerstop As Integer
'Aは11にも1にもなる
Dim syoubu As Integer
Cells.Clear
playertotal = 0
dealertotal = 0
playerstop = 0
dealerstop = 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(11) = Henkan(11, card(11))
dealertotal = dealertotal + dealer(11)
Cells(10, 2) = "合計は"
Cells(10, 3) = dealertotal
'ディーラーの1枚目を見てプレイヤーの判断
If playerstop = 0 And dealertotal < 7 And dealertotal <> 11 And playertotal > 11 Then
Cells(6, 1) = "ディーラーバーストに期待！"
playerstop = 1
Else
Cells(6, 1) = ""
End If
'プレイヤーバーストか？17以上まで引く
If playerstop = 0 Then
'iの定義し直し
For i = 5 To 9
player(i) = Henkan(i, card(i))
playertotal = playertotal + player(i)
Cells(2, 3) = playertotal
'先にバーストからのチェックをしなければならない
If playertotal > 21 Then
'11があるか？あるなら11を1にする
For j = 3 To 9
If player(j) = 11 Then
player(j) = 1
playertotal = playertotal - 10
Exit For
End If
Next
'もう一度バーストかチェック
If playertotal > 21 Then
Cells(2, 4) = "バーストT_T"
'ディーラーの勝ち
syoubu = 2
Exit For
End If
End If
If playertotal > 16 Then
'ショーダウンへ
syoubu = 0
Exit For
End If
Next
End If
'ディーラーの2枚目以降、16以下は機械的にめくる
dealer(2) = Henkan(12, card(12))
dealertotal = dealertotal + dealer(2)
Cells(10, 2) = "合計は"
Cells(10, 3) = dealertotal
'ディーラーブラックジャック？
If dealertotal = 21 Then
Cells(13, 1) = "ブラックジャック"
dealerstop = 1
End If
If dealerstop = 0 Then
For i = 13 To 17
dealer(i) = Henkan(i, card(i))
dealertotal = dealertotal + dealer(i)
Cells(10, 3) = dealertotal
'先にバーストからのチェックをしなければならない
If dealertotal > 21 Then
'11があるか？あるなら11を1にする
For j = 11 To 19
If dealer(j) = 11 Then
dealer(j) = 1
dealertotal = dealertotal - 10
Exit For
End If
Next
'もう一度バーストかチェック
If dealertotal > 21 Then
Cells(10, 4) = "バースト"
dealerstop = 1
Exit For
End If
End If
If dealertotal > 16 Then
'ショーダウンへ
syoubu = 1
Exit For
End If
Next
End If
'ショーダウン
'結果によるチップの増減
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
