Home > Excel VBA | Roulette > ルーレットシステムシミュレーション Roulette System Simulation

ルーレットシステムシミュレーション Roulette System Simulation

Posted by: WebMaster
2008年4月22日 09:55
Excel VBA | Roulette

このプログラムは、株などのシステムトレードのように、ルーレットシステムが成立するかどうかを簡単に検証するものです。答えは、このページで説明しているようにほぼ１００％不可能です。

画像は、仮想ルーレットデータを10,000回の乱数を発生させて以下を検証したものです。

ルーレットがRed,Red, Evenと続いたとき、Redに５％
ルーレットがRed,Red, Even, Even, Blackと続いたとき、Odd（奇数)に1５％
ルーレットがRed,Red, Even, Even, Black, Black,Oddと続いたとき、Blackに25％

結果は、図の例のように時々プラスに転じる場合があります。

This program verifies whether you can build a Roulette System like trading system of Stock market.　The answer is, almost 100% impossible because distortion of odds has no trend. For example, if you repeat trading in stock market when stock price does not change, you'll never make anything.

Image is verification of 10,000 times virtual roulette data according to probability below.

Bet 5% of funds to "Red" when roulette become as Red,Red,Even.
Bet 15% of funds to "Odd" when roulette become as Red,Red,Even,Even,Black.
Bet 25% of funds to "Black" when roulette become as Red,Red,Even,Even,Black,Black,Odd.

As a result in this case, become 650000 profit. Sometime it's happened. We call it "luck". Chart of profit and loss curve is below.

~~Download is under preparation~~

Download Roulette System Simulation

損益曲線は以下のとおりです。

House Edge(5.27%) of Roulette seems to be small, but this program is teaching how large it is! . The answer whether if you win or lose the gamble like roulette, is depend on invisible credit or debt. Result is always talking to keep acquiring virtue.

以下のコードは、乱数を発生させてルーレットの仮想データを作るものです。

This source code randomize numerical value and make virtual roulette data.

Private Sub CommandButton1_Click() ''---Create Randamized Data
Dim Odd, Even, Red, Black, House As Long
Application.ScreenUpdating = False
Sheets("Sheet1").Activate
Range("N:R").ClearContents

iCount = IIf(CLng(TextBox1.Value) >= 65000, 65000, CLng(TextBox1.Value))
Range("B2", "B" & iCount).clear

Odd = 0: Even = 0: Red = 0: Black = 0: House = 0
Randomize
''------------------------------------------
''---1=RED 2=BLACK 3=ODD 4=EVEN
''------------------------------------------
''---13 = RED & ODD
''---14 = RED & EVEN
''---23 = BLACK & ODD
''---24 = BLACK & EVEN
''------------------------------------------
''---Above codes is written in Column "V".
''---It's also possible to store in array instead of using cells.
''---using array is more efficient than using cells.
''---VB donot implement G.C., that is the reason I safer way.
''------------------------------------------
For i = 0 To iCount
 Temp = Rnd * 100
 If Temp <= (100 / 38) Then
  Range("B" & i + 2).Value = 1
  Range("V" & i + 2).Value = 13
  Range("B" & i + 2).Activate
    With Selection.Interior
        .ColorIndex = 3
        .Pattern = xlSolid
    End With
 ElseIf Temp <= (100 / 38) * 2 Then
  Range("B" & i + 2).Value = 2
  Range("V" & i + 2).Value = 24
  Range("B" & i + 2).Activate
    With Selection.Interior
        .ColorIndex = 1
        .Pattern = xlSolid
    End With
 ElseIf Temp <= (100 / 38) * 3 Then
  Range("B" & i + 2).Value = 3
  Range("V" & i + 2).Value = 13
  Range("B" & i + 2).Activate
    With Selection.Interior
        .ColorIndex = 3
        .Pattern = xlSolid
    End With

''-------------------rests are ommited-------------------
''-------------------省略-------------------

End If
Next 
Application.ScreenUpdating = True

End Sub

下記コードはメインプログラムです。最初は簡単なものを作る予定でしたが、いろんなオプションを付け加えていたら複雑なものになってしまいました。テストデータ数が多くなると簡単なコードでは時間がかかり過ぎるため、かなり効率化しています。

This is the main program.

Private Sub CommandButton2_Click()
''---------------------------------------------------------------------------
''---Feel free to contact me or leave comment.
''---------------------------------------------------------------------------
''---http://www.samurai-logic.com/mt/
''---------------------------------------------------------------------------

Dim Asset#, Result#, GROSS#, lastRow&
Dim CompData, Temp, TempData, TempO, TempR, TempBet, Roulette() As String
Dim Rate() As Double
Dim WinLoss, CompBet() As Boolean

Application.ScreenUpdating = False
UserForm1.ProgressBar2.Value = 0
GROSS = 0
lastRow = Range("B2").End(xlDown).Row

iCount = IIf(lastRow < CLng(TextBox4.Value), lastRow, CLng(TextBox4.Value))
''----CompData is past datas which are selected on UserForm
CompData = "" ''---incantation!
For i = 0 To 9
 CompData = CompData & SystemData(i)  ''---1=Red 2=Black 3=Odd 4=Even
Next

ReDim Roulette(iCount)
''----------------------------------------------------------------
''---Red-Odd = 11　Red-Even = 12　Black-Odd = 21　Black-Even = 22
''----------------------------------------------------------------
For i = 0 To iCount - 2
 Roulette(i) = CStr(Range("V" & i + 2).Value) ''---substitute result ofroulette
Next

ReDim CompBet(9)

For i = 2 To lastRow
 Range("C" & i).Value = 0
Next

ReDim Rate(3, 8)
''-------------------------------------------
For i = 12 To iCount
Temp = "": TempR = "": TempO = ""

For j = 0 To 9
  TempData = Mid$(CompData, j + 1, 1)
  Temp = Temp & TempData
  TempR = IIf(TempData = "1" Or TempData = "2", TempR & Mid$(Roulette(i + j - 10), 1, 1), TempR & Mid$(Roulette(i + j - 10), 2, 1))
  TempO = IIf(TempData = "3" Or TempData = "4", TempO & Mid$(Roulette(i + j - 10), 1, 1), TempO & Mid$(Roulette(i + j - 10), 2, 1))
   
   If j >= 1 Then CompBet(j - 1) = IIf(Temp = TempR, True, False)
 Next j
''-------------------------------------------------------------------CompBet(0)
If CheckBox1.Value = True And CompBet(0) = True Then    ''---If BET

Result = CDbl(TextBox3.Value) * CDbl(TextBox2.Value) * 0.01

Select Case Bet(0)
  Case 1  ''---case Red
   WinLoss = IIf(Mid$(TempR, 3, 1) = "1" Or Mid$(TempO, 3, 1) = "1", True, False)
   Range("C" & i - 6).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 6).Value) + Result, CDbl(Range("C" & i - 6).Value) - Result)
   Rate(1, 0) = IIf(WinLoss = True, Rate(1, 0) + 1, Rate(1, 0))
  Case 2 ''---case Black
   WinLoss = IIf(Mid$(TempR, 3, 1) = "2" Or Mid$(TempO, 3, 1) = "2", True, False)
   Range("C" & i - 6).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 6).Value) + Result, CDbl(Range("C" & i - 6).Value) - Result)
   Rate(1, 0) = IIf(WinLoss = True, Rate(1, 0) + 1, Rate(1, 0))
  Case 3  ''---case Odd
   WinLoss = IIf(Mid$(TempR, 3, 1) = "3" Or Mid$(TempO, 3, 1) = "3", True, False)
   Range("C" & i - 6).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 6).Value) + Result, CDbl(Range("C" & i - 6).Value) - Result)
   Rate(1, 0) = IIf(WinLoss = True, Rate(1, 0) + 1, Rate(1, 0))
  Case 4  ''---case Even
   WinLoss = IIf(Mid$(TempR, 3, 1) = "4" Or Mid$(TempO, 3, 1) = "4", True, False)
   Range("C" & i - 6).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 6).Value) + Result, CDbl(Range("C" & i - 6).Value) - Result)
   Rate(1, 0) = IIf(WinLoss = True, Rate(1, 0) + 1, Rate(1, 0))
 End Select
 ''---(0,0)=all---(1,0)=win---(2,0)="5"---(3,0)=profit
 Rate(0, 0) = IIf(CInt(Mid$(TempR, 3, 1)) <= 4 Or CInt(Mid$(TempO, 3, 1)) <= 4, Rate(0, 0) + 1, Rate(0, 0))
 Rate(2, 0) = IIf(Mid$(TempR, 3, 1) = "5" Or Mid$(TempO, 3, 1) = "5", Rate(2, 0) + 1, Rate(2, 0))
 Rate(3, 0) = IIf(WinLoss = True, Rate(3, 0) + Result, Rate(3, 0) - Result)
End If
''-------------------------------------------------------------------CompBet(1)
If CheckBox2.Value = True And CompBet(1) = True Then    ''---If BET

Result = CDbl(TextBox3.Value) * CDbl(TextBox5.Value) * 0.01

Select Case Bet(1)
  Case 1  ''---case Red
   WinLoss = IIf(Mid$(TempR, 4, 1) = "1" Or Mid$(TempO, 4, 1) = "1", True, False)
   Range("C" & i - 5).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 5).Value) + Result, CDbl(Range("C" & i - 5).Value) - Result)
   Rate(1, 1) = IIf(WinLoss = True, Rate(1, 1) + 1, Rate(1, 1))
  Case 2 ''---case Black
   WinLoss = IIf(Mid$(TempR, 4, 1) = "2" Or Mid$(TempO, 4, 1) = "2", True, False)
   Range("C" & i - 5).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 5).Value) + Result, CDbl(Range("C" & i - 5).Value) - Result)
   Rate(1, 1) = IIf(WinLoss = True, Rate(1, 1) + 1, Rate(1, 1))
  Case 3  ''---case Odd
   WinLoss = IIf(Mid$(TempR, 4, 1) = "3" Or Mid$(TempO, 4, 1) = "3", True, False)
   Range("C" & i - 5).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 5).Value) + Result, CDbl(Range("C" & i - 5).Value) - Result)
   Rate(1, 1) = IIf(WinLoss = True, Rate(1, 1) + 1, Rate(1, 1))
  Case 4  ''---case Even
   WinLoss = IIf(Mid$(TempR, 4, 1) = "4" Or Mid$(TempO, 4, 1) = "4", True, False)
   Range("C" & i - 5).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 5).Value) + Result, CDbl(Range("C" & i - 5).Value) - Result)
   Rate(1, 1) = IIf(WinLoss = True, Rate(1, 1) + 1, Rate(1, 1))
 End Select
  Rate(0, 1) = IIf(CInt(Mid$(TempR, 4, 1)) <= 4 Or CInt(Mid$(TempO, 4, 1)) <= 4, Rate(0, 1) + 1, Rate(0, 1))
  Rate(2, 1) = IIf(Mid$(TempR, 4, 1) = "5" Or Mid$(TempO, 4, 1) = "5", Rate(2, 1) + 1, Rate(2, 1))
  Rate(3, 1) = IIf(WinLoss = True, Rate(3, 1) + Result, Rate(3, 1) - Result)
End If

''------------------------------------------------------------------CompBet(2)
If CheckBox3.Value = True And CompBet(2) = True Then    ''---If BET

Result = CDbl(TextBox3.Value) * CDbl(TextBox6.Value) * 0.01

Select Case Bet(2)
  Case 1  ''---case Red
   WinLoss = IIf(Mid$(TempR, 5, 1) = "1" Or Mid$(TempO, 5, 1) = "1", True, False)
   Range("C" & i - 4).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 4).Value) + Result, CDbl(Range("C" & i - 4).Value) - Result)
   Rate(1, 2) = IIf(WinLoss = True, Rate(1, 2) + 1, Rate(1, 2))
  Case 2 ''---case Black
   WinLoss = IIf(Mid$(TempR, 5, 1) = "2" Or Mid$(TempO, 5, 1) = "2", True, False)
   Range("C" & i - 4).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 4).Value) + Result, CDbl(Range("C" & i - 4).Value) - Result)
   Rate(1, 2) = IIf(WinLoss = True, Rate(1, 2) + 1, Rate(1, 2))
  Case 3  ''---case Odd
   WinLoss = IIf(Mid$(TempR, 5, 1) = "3" Or Mid$(TempO, 5, 1) = "3", True, False)
   Range("C" & i - 4).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 4).Value) + Result, CDbl(Range("C" & i - 4).Value) - Result)
   Rate(1, 2) = IIf(WinLoss = True, Rate(1, 2) + 1, Rate(1, 2))
  Case 4  ''---case Even
   WinLoss = IIf(Mid$(TempR, 5, 1) = "4" Or Mid$(TempO, 5, 1) = "4", True, False)
   Range("C" & i - 4).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 4).Value) + Result, CDbl(Range("C" & i - 4).Value) - Result)
   Rate(1, 2) = IIf(WinLoss = True, Rate(1, 2) + 1, Rate(1, 2))
 End Select
  Rate(0, 2) = IIf(CInt(Mid$(TempR, 5, 1)) <= 4 Or CInt(Mid$(TempO, 5, 1)) <= 4, Rate(0, 2) + 1, Rate(0, 2))
  Rate(2, 2) = IIf(Mid$(TempR, 5, 1) = "5" Or Mid$(TempO, 5, 1) = "5", Rate(2, 2) + 1, Rate(2, 2))
  Rate(3, 2) = IIf(WinLoss = True, Rate(3, 2) + Result, Rate(3, 2) - Result)
End If

''------------------------------------------------------------------CompBet(3)
If CheckBox4.Value = True And CompBet(3) = True Then    ''---If BET

Result = CDbl(TextBox3.Value) * CDbl(TextBox7.Value) * 0.01

Select Case Bet(3)
  Case 1  ''---case Red
   WinLoss = IIf(Mid$(TempR, 6, 1) = "1" Or Mid$(TempO, 6, 1) = "1", True, False)
   Range("C" & i - 3).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 3).Value) + Result, CDbl(Range("C" & i - 3).Value) - Result)
   Rate(1, 3) = IIf(WinLoss = True, Rate(1, 3) + 1, Rate(1, 3))
  Case 2 ''---case Black
   WinLoss = IIf(Mid$(TempR, 6, 1) = "2" Or Mid$(TempO, 6, 1) = "2", True, False)
   Range("C" & i - 3).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 3).Value) + Result, CDbl(Range("C" & i - 3).Value) - Result)
   Rate(1, 3) = IIf(WinLoss = True, Rate(1, 3) + 1, Rate(1, 3))
  Case 3  ''---case Odd
   WinLoss = IIf(Mid$(TempR, 6, 1) = "3" Or Mid$(TempO, 6, 1) = "3", True, False)
   Range("C" & i - 3).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 3).Value) + Result, CDbl(Range("C" & i - 3).Value) - Result)
   Rate(1, 3) = IIf(WinLoss = True, Rate(1, 3) + 1, Rate(1, 3))
  Case 4  ''---case Even
   WinLoss = IIf(Mid$(TempR, 6, 1) = "4" Or Mid$(TempO, 6, 1) = "4", True, False)
   Range("C" & i - 3).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 3).Value) + Result, CDbl(Range("C" & i - 3).Value) - Result)
   Rate(1, 3) = IIf(WinLoss = True, Rate(1, 3) + 1, Rate(1, 3))
 End Select
  Rate(0, 3) = IIf(CInt(Mid$(TempR, 6, 1)) <= 4 Or CInt(Mid$(TempO, 6, 1)) <= 4, Rate(0, 3) + 1, Rate(0, 3))
  Rate(2, 3) = IIf(Mid$(TempR, 6, 1) = "5" Or Mid$(TempO, 6, 1) = "5", Rate(2, 3) + 1, Rate(2, 3))
  Rate(3, 3) = IIf(WinLoss = True, Rate(3, 3) + Result, Rate(3, 3) - Result)
End If

''------------------------------------------------------------------CompBet(4)
If CheckBox5.Value = True And CompBet(4) = True Then    ''---If BET

Result = CDbl(TextBox3.Value) * CDbl(TextBox8.Value) * 0.01

Select Case Bet(4)
  Case 1  ''---case Red
   WinLoss = IIf(Mid$(TempR, 7, 1) = "1" Or Mid$(TempO, 7, 1) = "1", True, False)
   Range("C" & i - 2).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 2).Value) + Result, CDbl(Range("C" & i - 2).Value) - Result)
   Rate(1, 4) = IIf(WinLoss = True, Rate(1, 4) + 1, Rate(1, 4))
  Case 2 ''---case Black
   WinLoss = IIf(Mid$(TempR, 7, 1) = "2" Or Mid$(TempO, 7, 1) = "2", True, False)
   Range("C" & i - 2).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 2).Value) + Result, CDbl(Range("C" & i - 2).Value) - Result)
   Rate(1, 4) = IIf(WinLoss = True, Rate(1, 4) + 1, Rate(1, 4))
  Case 3  ''---case Odd
   WinLoss = IIf(Mid$(TempR, 7, 1) = "3" Or Mid$(TempO, 7, 1) = "3", True, False)
   Range("C" & i - 2).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 2).Value) + Result, CDbl(Range("C" & i - 2).Value) - Result)
   Rate(1, 4) = IIf(WinLoss = True, Rate(1, 4) + 1, Rate(1, 4))
  Case 4  ''---case Even
   WinLoss = IIf(Mid$(TempR, 7, 1) = "4" Or Mid$(TempO, 7, 1) = "4", True, False)
   Range("C" & i - 2).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 2).Value) + Result, CDbl(Range("C" & i - 2).Value) - Result)
   Rate(1, 4) = IIf(WinLoss = True, Rate(1, 4) + 1, Rate(1, 4))
 End Select
  Rate(0, 4) = IIf(CInt(Mid$(TempR, 7, 1)) <= 4 Or CInt(Mid$(TempO, 7, 1)) <= 4, Rate(0, 4) + 1, Rate(0, 4))
  Rate(2, 4) = IIf(Mid$(TempR, 7, 1) = "5" Or Mid$(TempO, 7, 1) = "5", Rate(2, 4) + 1, Rate(2, 4))
  Rate(3, 4) = IIf(WinLoss = True, Rate(3, 4) + Result, Rate(3, 4) - Result)
End If

''------------------------------------------------------------------CompBet(5)
If CheckBox6.Value = True And CompBet(5) = True Then    ''---If BET

Result = CDbl(TextBox3.Value) * CDbl(TextBox9.Value) * 0.01

Select Case Bet(5)
  Case 1  ''---case Red
   WinLoss = IIf(Mid$(TempR, 8, 1) = "1" Or Mid$(TempO, 8, 1) = "1", True, False)
   Range("C" & i - 1).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 1).Value) + Result, CDbl(Range("C" & i - 1).Value) - Result)
   Rate(1, 5) = IIf(WinLoss = True, Rate(1, 5) + 1, Rate(1, 5))
  Case 2 ''---case Black
   WinLoss = IIf(Mid$(TempR, 8, 1) = "2" Or Mid$(TempO, 8, 1) = "2", True, False)
   Range("C" & i - 1).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 1).Value) + Result, CDbl(Range("C" & i - 1).Value) - Result)
   Rate(1, 5) = IIf(WinLoss = True, Rate(1, 5) + 1, Rate(1, 5))
  Case 3  ''---case Odd
   WinLoss = IIf(Mid$(TempR, 8, 1) = "3" Or Mid$(TempO, 8, 1) = "3", True, False)
   Range("C" & i - 1).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 1).Value) + Result, CDbl(Range("C" & i - 1).Value) - Result)
   Rate(1, 5) = IIf(WinLoss = True, Rate(1, 5) + 1, Rate(1, 5))
  Case 4  ''---case Even
   WinLoss = IIf(Mid$(TempR, 8, 1) = "4" Or Mid$(TempO, 8, 1) = "4", True, False)
   Range("C" & i - 1).Value = IIf(WinLoss = True, CDbl(Range("C" & i - 1).Value) + Result, CDbl(Range("C" & i - 1).Value) - Result)
   Rate(1, 5) = IIf(WinLoss = True, Rate(1, 5) + 1, Rate(1, 5))
 End Select
  Rate(0, 5) = IIf(CInt(Mid$(TempR, 8, 1)) <= 4 Or CInt(Mid$(TempO, 8, 1)) <= 4, Rate(0, 5) + 1, Rate(0, 5))
  Rate(2, 5) = IIf(Mid$(TempR, 8, 1) = "5" Or Mid$(TempO, 8, 1) = "5", Rate(2, 5) + 1, Rate(2, 5))
  Rate(3, 5) = IIf(WinLoss = True, Rate(3, 5) + Result, Rate(3, 5) - Result)
End If

''------------------------------------------------------------------CompBet(6)
If CheckBox7.Value = True And CompBet(6) = True Then    ''---If BET

Result = CDbl(TextBox3.Value) * CDbl(TextBox10.Value) * 0.01

Select Case Bet(6)
  Case 1  ''---case Red
   WinLoss = IIf(Mid$(TempR, 9, 1) = "1" Or Mid$(TempO, 9, 1) = "1", True, False)
   Range("C" & i).Value = IIf(WinLoss = True, CDbl(Range("C" & i).Value) + Result, CDbl(Range("C" & i).Value) - Result)
   Rate(1, 6) = IIf(WinLoss = True, Rate(1, 6) + 1, Rate(1, 6))
  Case 2 ''---case Black
   WinLoss = IIf(Mid$(TempR, 9, 1) = "2" Or Mid$(TempO, 9, 1) = "2", True, False)
   Range("C" & i).Value = IIf(WinLoss = True, CDbl(Range("C" & i).Value) + Result, CDbl(Range("C" & i).Value) - Result)
   Rate(1, 6) = IIf(WinLoss = True, Rate(1, 6) + 1, Rate(1, 6))
  Case 3  ''---case Odd
   WinLoss = IIf(Mid$(TempR, 9, 1) = "3" Or Mid$(TempO, 9, 1) = "3", True, False)
   Range("C" & i).Value = IIf(WinLoss = True, CDbl(Range("C" & i).Value) + Result, CDbl(Range("C" & i).Value) - Result)
   Rate(1, 6) = IIf(WinLoss = True, Rate(1, 6) + 1, Rate(1, 6))
  Case 4  ''---case Even
   WinLoss = IIf(Mid$(TempR, 9, 1) = "4" Or Mid$(TempO, 9, 1) = "4", True, False)
   Range("C" & i).Value = IIf(WinLoss = True, CDbl(Range("C" & i).Value) + Result, CDbl(Range("C" & i).Value) - Result)
   Rate(1, 6) = IIf(WinLoss = True, Rate(1, 6) + 1, Rate(1, 6))
 End Select
  Rate(0, 6) = IIf(CInt(Mid$(TempR, 9, 1)) <= 4 Or CInt(Mid$(TempO, 9, 1)) <= 4, Rate(0, 6) + 1, Rate(0, 6))
  Rate(2, 6) = IIf(Mid$(TempR, 9, 1) = "5" Or Mid$(TempO, 9, 1) = "5", Rate(2, 6) + 1, Rate(2, 6))
  Rate(3, 6) = IIf(WinLoss = True, Rate(3, 6) + Result, Rate(3, 6) - Result)
End If
''------------------------------------------------------------------CompBet(7)
If CheckBox8.Value = True And CompBet(7) = True Then    ''---If BET

Result = CDbl(TextBox3.Value) * CDbl(TextBox11.Value) * 0.01

Select Case Bet(7)
  Case 1  ''---case Red
   WinLoss = IIf(Mid$(TempR, 10, 1) = "1" Or Mid$(TempO, 10, 1) = "1", True, False)
   Range("C" & i + 1).Value = IIf(WinLoss = True, CDbl(Range("C" & i + 1).Value) + Result, CDbl(Range("C" & i + 1).Value) - Result)
   Rate(1, 7) = IIf(WinLoss = True, Rate(1, 7) + 1, Rate(1, 7))
  Case 2 ''---case Black
   WinLoss = IIf(Mid$(TempR, 10, 1) = "2" Or Mid$(TempO, 10, 1) = "2", True, False)
   Range("C" & i + 1).Value = IIf(WinLoss = True, CDbl(Range("C" & i + 1).Value) + Result, CDbl(Range("C" & i + 1).Value) - Result)
   Rate(1, 7) = IIf(WinLoss = True, Rate(1, 7) + 1, Rate(1, 7))
  Case 3  ''---case Odd
   WinLoss = IIf(Mid$(TempR, 10, 1) = "3" Or Mid$(TempO, 10, 1) = "3", True, False)
   Range("C" & i + 1).Value = IIf(WinLoss = True, CDbl(Range("C" & i + 1).Value) + Result, CDbl(Range("C" & i + 1).Value) - Result)
   Rate(1, 7) = IIf(WinLoss = True, Rate(1, 7) + 1, Rate(1, 7))
  Case 4  ''---case Even
   WinLoss = IIf(Mid$(TempR, 10, 1) = "4" Or Mid$(TempO, 10, 1) = "4", True, False)
   Range("C" & i + 1).Value = IIf(WinLoss = True, CDbl(Range("C" & i + 1).Value) + Result, CDbl(Range("C" & i + 1).Value) - Result)
   Rate(1, 7) = IIf(WinLoss = True, Rate(1, 7) + 1, Rate(1, 7))
 End Select
  Rate(0, 7) = IIf(CInt(Mid$(TempR, 10, 1)) <= 4 Or CInt(Mid$(TempO, 10, 1)) <= 4, Rate(0, 7) + 1, Rate(0, 7))
  Rate(2, 7) = IIf(Mid$(TempR, 10, 1) = "5" Or Mid$(TempO, 10, 1) = "5", Rate(2, 7) + 1, Rate(2, 7))
  Rate(3, 7) = IIf(WinLoss = True, Rate(3, 7) + Result, Rate(3, 7) - Result)
End If
''------------------------------------------------------------------CompBet(8)
If CheckBox9.Value = True And CompBet(8) = True Then    ''---If BET

Result = CDbl(TextBox3.Value) * CDbl(TextBox12.Value) * 0.01

Select Case Bet(8)
  Case 1  ''---case Red
   WinLoss = IIf(Mid$(Roulette(i), 1, 1) = "1" Or Mid$(Roulette(i), 2, 1) = "1", True, False)
   Range("C" & i + 2).Value = IIf(WinLoss = True, CDbl(Range("C" & i + 2).Value) + Result, CDbl(Range("C" & i + 2).Value) - Result)
   Rate(1, 8) = IIf(WinLoss = True, Rate(1, 8) + 1, Rate(1, 8))
  Case 2 ''---case Black
   WinLoss = IIf(Mid$(Roulette(i), 1, 1) = "2" Or Mid$(Roulette(i), 2, 1) = "2", True, False)
   Range("C" & i + 2).Value = IIf(WinLoss = True, CDbl(Range("C" & i + 2).Value) + Result, CDbl(Range("C" & i + 2).Value) - Result)
   Rate(1, 8) = IIf(WinLoss = True, Rate(1, 8) + 1, Rate(1, 8))
  Case 3  ''---case Odd
   WinLoss = IIf(Mid$(Roulette(i), 1, 1) = "3" Or Mid$(Roulette(i), 2, 1) = "3", True, False)
   Range("C" & i + 2).Value = IIf(WinLoss = True, CDbl(Range("C" & i + 2).Value) + Result, CDbl(Range("C" & i + 2).Value) - Result)
   Rate(1, 8) = IIf(WinLoss = True, Rate(1, 8) + 1, Rate(1, 8))
  Case 4  ''---case Even
   WinLoss = IIf(Mid$(Roulette(i), 1, 1) = "4" Or Mid$(Roulette(i), 2, 1) = "4", True, False)
   Range("C" & i + 2).Value = IIf(WinLoss = True, CDbl(Range("C" & i + 2).Value) + Result, CDbl(Range("C" & i + 2).Value) - Result)
   Rate(1, 8) = IIf(WinLoss = True, Rate(1, 8) + 1, Rate(1, 8))
 End Select
  Rate(0, 8) = IIf(CInt(Mid$(Roulette(i), 2, 1)) <= 4 Or CInt(Mid$(Roulette(i), 1, 1)) <= 4, Rate(0, 8) + 1, Rate(0, 8))
  Rate(2, 8) = IIf(Mid$(Roulette(i), 11, 1) = "5" Or Mid$(Roulette(i), 11, 1) = "5", Rate(2, 8) + 1, Rate(2, 8))
  Rate(3, 8) = IIf(WinLoss = True, Rate(3, 8) + Result, Rate(3, 8) - Result)
End If
UserForm1.ProgressBar2.Value = (i * 95) / iCount
Next

GROSS = WorksheetFunction.Sum(Range("C2", "C" & iCount))
''------------------------------------------------------------------------
''-----Labels are used to show the results of Roulette
''------------------------------------------------------------------------
Label_T.Visible = True
Label1_1.Caption = "Win :" & CStr(Rate(1, 0))
Label1_2.Caption = "Loss:" & CStr((Rate(0, 0) - Rate(1, 0) + Rate(2, 0)))
Label1_3.Caption = CStr(Rate(3, 0))
Label1_3.ForeColor = IIf(Rate(3, 0) > 0, &H0&, &HFF&)

Label2_1.Caption = "Win :" & CStr(Rate(1, 1))
Label2_2.Caption = "Loss:" & CStr((Rate(0, 1) - Rate(1, 1) + Rate(2, 1)))
Label2_3.Caption = CStr(Rate(3, 1))
Label2_3.ForeColor = IIf(Rate(3, 1) > 0, &H0&, &HFF&)

Label3_1.Caption = "Win :" & CStr(Rate(1, 2))
Label3_2.Caption = "Loss:" & CStr((Rate(0, 2) - Rate(1, 2) + Rate(2, 2)))
Label3_3.Caption = CStr(Rate(3, 2))
Label3_3.ForeColor = IIf(Rate(3, 2) > 0, &H0&, &HFF&)

Label4_1.Caption = "Win :" & CStr(Rate(1, 3))
Label4_2.Caption = "Loss:" & CStr((Rate(0, 3) - Rate(1, 3) + Rate(2, 3)))
Label4_3.Caption = CStr(Rate(3, 3))
Label4_3.ForeColor = IIf(Rate(3, 3) > 0, &H0&, &HFF&)

Label5_1.Caption = "Win :" & CStr(Rate(1, 4))
Label5_2.Caption = "Loss:" & CStr((Rate(0, 4) - Rate(1, 4) + Rate(2, 4)))
Label5_3.Caption = CStr(Rate(3, 4))
Label5_3.ForeColor = IIf(Rate(3, 4) > 0, &H0&, &HFF&)

Label6_1.Caption = "Win :" & CStr(Rate(1, 5))
Label6_2.Caption = "Loss:" & CStr((Rate(0, 5) - Rate(1, 5) + Rate(2, 5)))
Label6_3.Caption = CStr(Rate(3, 5))
Label6_3.ForeColor = IIf(Rate(3, 5) > 0, &H0&, &HFF&)

Label7_1.Caption = "Win :" & CStr(Rate(1, 6))
Label7_2.Caption = "Loss:" & CStr((Rate(0, 6) - Rate(1, 6) + Rate(2, 6)))
Label7_3.Caption = CStr(Rate(3, 6))
Label7_3.ForeColor = IIf(Rate(3, 6) > 0, &H0&, &HFF&)

Label8_1.Caption = "Win :" & CStr(Rate(1, 7))
Label8_2.Caption = "Loss:" & CStr((Rate(0, 7) - Rate(1, 7) + Rate(2, 7)))
Label8_3.Caption = CStr(Rate(3, 7))
Label8_3.ForeColor = IIf(Rate(3, 7) > 0, &H0&, &HFF&)

Label9_1.Caption = "Win :" & CStr(Rate(1, 8))
Label9_2.Caption = "Loss:" & CStr((Rate(0, 8) - Rate(1, 8) + Rate(2, 8)))
Label9_3.Caption = CStr(Rate(3, 8))
Label9_3.ForeColor = IIf(Rate(3, 8) > 0, &H0&, &HFF&)

Label_G.ForeColor = IIf(GROSS > 0, &H0&, &HFF&)
Label_G.Caption = CStr(GROSS)
DoEvents

Range("X4").Value = CDbl(TextBox3.Value)
For i = 5 To iCount
 Range("X" & i).Value = CDbl(Range("C" & i).Value) + CDbl(Range("X" & i - 1))
Next

''---Do not forget to erase memory
Erase Roulette
Erase CompBet
Erase Rate

UserForm1.ProgressBar2.Value = (iCount * 98) / iCount
DoEvents

ActiveSheet.ChartObjects(1).Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("X14", "X" & iCount), PlotBy:=xlColumns
 With ActiveChart.Axes(xlCategory)
     .TickLabelSpacing = iCount / 10
     .TickMarkSpacing = iCount / 10
 End With
UserForm1.ProgressBar2.Value = 100
DoEvents

Application.ScreenUpdating = True
End Sub

Comments:0

Amazon.co.jp ウィジェット

Home > Excel VBA | Roulette > ルーレットシステムシミュレーション Roulette System Simulation

Return to page top