Sub BJSIM()

'ブラックジャックのシミュレーション
'目標値（Target）と試行回数（i）を設定して実行する
'結果はカレントシートに書き込む
'※実行前にカレントシート全体に「数式と値をクリア」をしておくこと
'　　（試行結果書き出し時にクリアしないので前の値が残ることがある）

Dim RCD(52) As Integer
Dim ncd(12), dcd(12) As Integer

'************** 実行条件の設定 *********************************
   Target = 15  '目標値（この値に達してたら次のカードを引かない）
   Ntry=100000  '試行回数
   Ndsp = 1000  '初めのNdsp回の試行状況をシートに書き出す
   Ichk=10000   '途中経過の書き出し間隔
'***************************************************************

   NNW = 0   '子（Non-dealer）の勝
   NDW = 0   '親（Dealer）の勝
   NDR = 0   '引分
   NBJ = 0   '子がブラックジャック
   NBS = 0   '子がBust
      
   Cells(1, 1).Value = "目標値"
   Cells(1, 2).Value = Target
   Cells(2, 1).Value = "勝"
   Cells(3, 1).Value = "うちBJ"
   Cells(4, 1).Value = "負"
   Cells(5, 1).Value = "うちBust"
   Cells(6, 1).Value = "引分"
   Cells(7, 1).Value = "勝率"
   
   For i = 1 To Ntry  '試行回数
   Call rdcard(RCD)
   Call PKcard(nn, ncd, Target, RCD, 0)
   Call PKcard(dn, dcd, 17, RCD, 26)   '親の目標値は17とする

   WLFLG = ""
   BJBS = ""
   If nn >= 22 Then
      WLFLG = "D"      '子がBustのときは親の勝ち
      NDW = NDW + 1
      NBS = NBS + 1
      BJBS = "BUST"
   ElseIf nn > 21 Then   '21.1はBlackJack
      NNW = NNW + 1
      NBJ = NBJ + 1
      BJBS = "BJ"
      WLFLG = "N"
   ElseIf dn >= 22 Then
      NNW = NNW + 1
      WLFLG = "N"
   ElseIf dn > nn Then
      NDW = NDW + 1
      WLFLG = "D"
   ElseIf dn < nn Then
      NNW = NNW + 1
      WLFLG = "N"
   Else
      NDR = NDR + 1
      WLFLG = "x"
   End If
   

   If (i Mod Ichk) = 0 Then   '進行状況をシート上に表示
      Cells(2, 2).Value = NNW
      Cells(3, 2).Value = NBJ
      Cells(4, 2).Value = NDW
      Cells(5, 2).Value = NBS
      Cells(6, 2).Value = NDR
      Cells(7, 2).Value = NNW / (NNW + NDW)
   End If
   
'**************************** 試行状況のチェック出力 *******************
   If i <= Ndsp Then           '最初のNdsp回の試行状況はシートに書き込む
      Cells(i + 8, 3).Value = nn
      Cells(i + 8, 17).Value = dn
      For j = 1 To 12   '子のカード一覧
         If ncd(j) = 0 Then GoTo CHK1
         Cells(i + 8, j + 3).Value = ncd(j)
      Next j
CHK1:
      For j = 1 To 12   '親のカード：子がBustでも引いてる（勝敗には無関係）
         If dcd(j) = 0 Then GoTo CHK2
         Cells(i + 8, j + 17).Value = dcd(j)
      Next j
CHK2:
      Cells(i + 8, 1).Value = WLFLG
      Cells(i + 8, 2).Value = BJBS
   End If
'**********************************************************************

   Next i
   
   Cells(2, 2).Value = NNW
   Cells(3, 2).Value = NBJ
   Cells(4, 2).Value = NDW
   Cells(5, 2).Value = NBS
   Cells(6, 2).Value = NDR
   Cells(7, 2).Value = NNW / (NNW + NDW)
   
End Sub




Sub PKcard(dn, dcd, m, RCD, offs)
'カードを引く
'   dn:  スコア（ブラックジャックのときは21.1）
'   dcd: カードリスト
'   m:   目標値
'   RCD: カードデック（ランダムカード）
'   offs:抜き出すカードの先頭位置
'         ※実際のゲームでは子のカードに続けて引くが、
'           面倒なので、同じカードが使われないよう十分離れたところを指定する

   For i = 1 To 12
      dcd(i) = 0
   Next i
   ACE = 0
   ACEP = 0
   
   dcd(1) = RCD(1 + offs)
   dn = dcd(1)
   If dcd(1) = 1 Then ACE = 1
   
   For i = 2 To 12
      dcd(i) = RCD(i + offs)
      If dcd(i) = 1 Then ACE = ACE + 1
      
      dn = dn + dcd(i)

      If ACE > 0 Then
         If dn + 10 > 21 Then
            ACE = ACE - 1
            GoTo LEND
         End If
         If dn + 10 >= m Then
            ACEP = 1
            dn = dn + 10
            GoTo DEND
         End If
      End If
      If dn >= m Then GoTo DEND
      If dn > 21 Then GoTo DEND
LEND:
   Next i

DEND:
   If ACEP = 1 Then
      For i = 1 To 12
         If dcd(i) = 1 Then
            dcd(i) = 11
            GoTo PEND
         End If
      Next i
   End If

PEND:
   If dn = 21 And dcd(3) = 0 Then dn = 21.1   'Black Jack
   
End Sub


Sub rdcard(RCD)
'カードをシャッフルする

Dim CD(52) As Integer

   For i = 0 To 3
      For j = 1 To 13
         CD(i * 13 + j) = Application.WorksheetFunction.Min(j, 10)
     Next j
   Next i
   
   For i = 52 To 2 Step -1
      rn = Fix(Rnd() * i) + 1
      RCD(53 - i) = CD(rn)
      For j = rn To 51
         CD(j) = CD(j + 1)
      Next j
   Next i
   RCD(52) = CD(1)
   
End Sub