Excel VBA 確率

Option Explicit

Sub 円周率MonteCarlo()
' Monte Carlo simulation

Dim i As Integer, j As Long
Dim 点の数 As Long
Dim 円の内側の数 As Long
Dim 円周率 As Double
Dim X座標 As Single
Dim Y座標 As Single
Dim 原点からの距離の2乗 As Double

    Randomize
    Call 既存データ削除

    Worksheets("Sheet1").Activate
    
    点の数 = 0
    円の内側の数 = 0
    
    For i = 1 To 30          '30回、結果をセルに表示する。
        For j = 1 To 100000  '1回毎に、10万個の点を打つ。
            点の数 = 点の数 + 1

            '横1、縦1の正方形の範囲に、ランダムに点を打つ。
            X座標 = Rnd(): Y座標 = Rnd()

            '原点を中心とする半径1の扇形の範囲に入っているかどうかを判定する。
            原点からの距離の2乗 = X座標 ^ 2 + Y座標 ^ 2
            
            If 原点からの距離の2乗 <= 1 Then  '円の内側
                円の内側の数 = 円の内側の数 + 1
            End If
        Next j
        
        円周率 = (円の内側の数 / 点の数) * 4
        Cells(2 + i, 1) = 点の数 / 10000 '表示は、万単位にする。
        Cells(2 + i, 2) = 円周率
        
    Next i
    
    Call グラフ作成

End Sub

'**************************************************

Private Sub 既存データ削除()

    Worksheets("Sheet1").Activate
    
    ActiveSheet.ChartObjects(1).Activate
    ActiveChart.ChartArea.Select
    ActiveWindow.Visible = False
    Selection.Delete  'Excel2007でエラーになるため修正
    ActiveChart.Parent.Delete
    
    Rows("3:50").Select
    Selection.Delete Shift:=xlUp
    Range("A3").Select

End Sub

Private Sub グラフ作成()

    Charts.Add
    ActiveChart.ChartType = xlLineMarkers
    ActiveChart.SetSourceData Source _
        :=Sheets("Sheet1").Range("B3:B32") _
        , PlotBy:=xlColumns
    ActiveChart.SeriesCollection(1).Name = "円周率π"
    ActiveChart.SeriesCollection(1).XValues = "=Sheet1!R3C1:R32C1"
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "円周率π"
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "点の数"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "円周率"
    End With
    With ActiveChart.Axes(xlCategory)
        .CrossesAt = 1
        .TickLabelSpacing = 4
        .TickMarkSpacing = 1
        .AxisBetweenCategories = True
        .ReversePlotOrder = False
    End With

    ActiveWindow.Visible = False
    Worksheets("Sheet1").Activate
    Range("B3").Select

End Sub

Option Explicit
Option Base 1

Sub 乱数の精度確認()

   Dim 最初 As Integer
   Dim 最後 As Integer
   Dim 乱数発生数(20, 2) As Integer
   Dim 開始日時 As Variant
   Dim 終了日時 As Variant
   Dim 試行回数 As Integer
   Dim 値 As Variant
   
   Worksheets("Sheet1").UsedRange.Clear
   Randomize ' 乱数生成器を初期化します。
   開始日時 = Now
   
   最初 = 1 ' 11
   最後 = 6 ' 20
   
   For 試行回数 = 1 To 10000
      値 = 乱数(最初, 最後)
      乱数発生数(値 - 最初 + 1, 1) = 乱数発生数(値 - 最初 + 1, 1) + 1
      値 = 乱数誤(最初, 最後)
      乱数発生数(値 - 最初 + 1, 2) = 乱数発生数(値 - 最初 + 1, 2) + 1
   Next 試行回数
   
   Worksheets("Sheet1").Range("A1").Resize(UBound(乱数発生数, 1), 2).Value = 乱数発生数

   終了日時 = Now
   MsgBox "処理時間は、" _
   & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"

End Sub


'' [最初, 最後]、つまり {最初 <= x <= 最後} の範囲の整数乱数を発生させる関数
Function 乱数(最初 As Integer, 最後 As Integer) As Integer
   'Rnd 関数は、0 以上 1 未満の値を返します。
   乱数 = Int(Rnd * (最後 - 最初 + 1)) + 最初
   'Int は、number の小数部分を取り除いて、その結果得られる整数値を返します。
   'このため Int を入れないと、最後より一つ大きい数が発生してしまいます。
End Function

Function 乱数誤(最初 As Integer, 最後 As Integer) As Integer
   'Rnd 関数は、0 以上 1 未満の値を返します。
   'Int を入れないと、最後より一つ大きい数が発生してしまいます。
   乱数誤 = Rnd * (最後 - 最初 + 1) + 最初
End Function

★★★ Sheet1 ★★★
Option Explicit


Private Sub CommandButton1_Click()
    Call 正規乱数発生
End Sub

Private Sub CommandButton2_Click()
    Call 二項乱数発生
End Sub

Private Sub CommandButton3_Click()
    Call 指数乱数発生
End Sub

Private Sub CommandButton4_Click()
    Call ポアソン乱数発生
End Sub


Private Sub CommandButton1_MouseMove _
(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'ボタンの上ではマウスを手の形に変更する
    'ハンドカーソルをコール
    rcLC = LoadCursor(0&, IDC_HAND)
    Call SetCursor(rcLC)
End Sub

Private Sub CommandButton2_MouseMove _
(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    rcLC = LoadCursor(0&, IDC_HAND)
    Call SetCursor(rcLC)
End Sub

Private Sub CommandButton3_MouseMove _
(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    rcLC = LoadCursor(0&, IDC_HAND)
    Call SetCursor(rcLC)
End Sub

Private Sub CommandButton4_MouseMove _
(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    rcLC = LoadCursor(0&, IDC_HAND)
    Call SetCursor(rcLC)
End Sub



★★★正規乱数モジュール★★★
Option Explicit

'正規乱数
Public 乱数の数 As Integer
Public 乱数名 As String
Dim 区間 As Integer
Dim i As Integer

Sub 正規乱数発生()
    Randomize

    区間 = 0

    Dim 乱数順位 As Integer
    乱数名 = "正規乱数(連続型)"  'グラフに乱数名を表示するため変数「乱数名」に登録します。

    Call 前回データを削除 '「セル行削除モジュール」で、まず表示中の前回結果を削除します。
    
    乱数の数 = Range("A3").Value 'セルから、パラメータとして発生させる乱数の数を受け取ります。
                                 'パソコンの性能にもよりますが、1,000個程度が適当でしょう。

    For 乱数順位 = 1 To 乱数の数 '指定した数だけ、関数「正規乱数」で乱数を発生させます。
        Range("A11").Cells(乱数順位, 1).Value = 正規乱数
        Range("A11").Cells(乱数順位, 1).NumberFormat = "#,##0.000_ "
    Next 乱数順位

    Call ヒストグラム区間指定(乱数の数, 区間, 乱数名)
    '引数として、乱数の数と乱数名を持って、[分析ツール-VBA] のヒストグラム作成処理に渡します。
    '区間は指定していないので、変数「区間」の値は「0」です。

    Call Excel正規分布関数 '結果の照合のため、Excel の関数を使って、累積確率を計算します。

End Sub


Function 正規乱数() As Single
    Dim 一様乱数 As Single

    一様乱数 = Rnd
    If 一様乱数 > 0.99999 Then 一様乱数 = 0.99999
    If 一様乱数 < 0.00001 Then 一様乱数 = 0.00001
    正規乱数 = WorksheetFunction.NormSInv(一様乱数)
End Function


Private Sub Excel正規分布関数()
    Range("F1").Cells(11, 1).Value = "参考Excel関数"
    For i = 12 To Cells(ActiveSheet.Rows.Count, 3).End(xlUp).Row - 1
        Range("F1").Cells(i, 1).Value = _
        WorksheetFunction.NormDist(Range("C1").Cells(i, 1).Value, 0, 1, 1) * 100
        Range("F1").Cells(i, 1).NumberFormat = "#,##0.00_ "
    Next i
End Sub


★★★二項乱数モジュール★★★
Option Explicit

'表が出るときの「確率」のコインを、「回数」、投げたときの点数の分布

Public 乱数の数 As Integer
Public 乱数名 As String
Public 回数 As Integer
Dim  区間 As Integer
Dim 確率 As Single
Dim i As Integer

Sub 二項乱数発生()
    Randomize

    Dim 乱数順位 As Integer
    乱数名 = "二項乱数(離散型)"

    Call 前回データを削除

    乱数の数 = Range("A3").Value
    確率 = Range("F4").Value
    If 確率 > 1 Then
        MsgBox "成功する確立は1以下にして下さい。"
        End
    End If

    If Range("F5").Value > 30000 Then
        MsgBox "試行回数の数が大きすぎます。" & Chr(13) & _
        "30,000未満に修正して下さい。"
        End
    End If
    回数 = Range("F5").Value  'この場合、グラフの区間は回数

     'ヒストグラムのデータ区間を整数にするため、明示的に区間指定用の数列をセルに書き込む。
    区間 = 回数
    For i = 0 To 区間 - 1
        Range("B13").Cells(i, 1).Value = i
    Next i
    
    For 乱数順位 = 1 To 乱数の数
        Range("A11").Cells(乱数順位, 1).Value = 二項乱数(回数, 確率)
        Range("A11").Cells(乱数順位, 1).NumberFormat = "#,##0_ "
    Next 乱数順位

    Call ヒストグラム区間指定(乱数の数, 区間, 乱数名)
    '引数に、ヒストグラム作成の「区間」を追加したルーチンに渡す。

    Call Excel二項分布関数

End Sub


Function 二項乱数(回数 As Integer, 確率 As Single) As Integer
    Dim i As Integer
    
    二項乱数 = 0
    For i = 1 To 回数
        二項乱数 = 二項乱数 + ベルヌーイ試行(確率)
    Next i
End Function


Function ベルヌーイ試行(確率 As Single) As Integer
    Dim 一様乱数 As Single

    一様乱数 = Rnd
    ベルヌーイ試行 = IIf(一様乱数 < 確率, 1, 0)
End Function


Private Sub Excel二項分布関数()
    Range("F1").Cells(11, 1).Value = "参考Excel関数"
    For i = 12 To Cells(ActiveSheet.Rows.Count, 3).End(xlUp).Row - 1
        Range("F1").Cells(i, 1).Value = _
        WorksheetFunction.BinomDist(Range("C1").Cells(i, 1).Value, 回数, 確率, 1) * 100
        Range("F1").Cells(i, 1).NumberFormat = "#,##0.00_ "
    Next i
End Sub


★★★指数乱数モジュール★★★
Option Explicit

'指数乱数
Public 乱数の数 As Integer
Public 乱数名 As String
Dim μ As Single
Dim 区間 As Integer
Dim i As Integer
Dim j As Integer
Dim 最大値 As Integer

Sub 指数乱数発生()
    Randomize

    Dim 乱数順位 As Integer

    乱数名 = "指数乱数(連続型)"

    Call 前回データを削除

    μ = Range("H4").Value
    If μ <= 0 Then
        MsgBox "μ(平均サービス率)は、正数にして下さい。"
        End
    End If
    
    乱数の数 = Range("A3").Value
    区間 = 0
    最大値 = 0

    For 乱数順位 = 1 To 乱数の数
        Range("A11").Cells(乱数順位, 1).Value = 指数乱数(1)
        Range("A11").Cells(乱数順位, 1).NumberFormat = "#,##0.000_ "

           '乱数の最大値を見つけて、データ区間にする。
        If 最大値 < Range("A11").Cells(乱数順位, 1).Value Then
            最大値 = WorksheetFunction.RoundUp(Range("A11").Cells(乱数順位, 1).Value, 0)
        End If

    Next 乱数順位
    
    If 最大値 > 3 Then
    区間 = 最大値
    j = 0
    For i = WorksheetFunction.RoundUp((1 / μ),0) To 区間 - 1 Step WorksheetFunction.RoundUp((1 / μ),0)
        Range("B13").Cells(j, 1).Value = i
        j = j + 1
    Next i
    End If

    Call ヒストグラム区間指定(乱数の数, 区間, 乱数名)

    Call Excel指数分布関数
    
End Sub

Function 指数乱数(ByVal μ As Single) As Single
    Dim 一様乱数 As Single

    一様乱数 = Rnd
    指数乱数 = -(1 / μ) * Log(一様乱数)
End Function

Private Sub Excel指数分布関数()
    Range("F1").Cells(11, 1).Value = "参考Excel関数"
    For i = 12 To Cells(ActiveSheet.Rows.Count, 3).End(xlUp).Row - 1
        Range("F1").Cells(i, 1).Value = _
        WorksheetFunction.ExponDist(Range("C1").Cells(i, 1).Value, μ, 1) * 100
        Range("F1").Cells(i, 1).NumberFormat = "#,##0.00_ "
    Next i
End Sub


★★★ポアソン乱数モジュール★★★
Option Explicit

'ポアソン乱数
Public 乱数の数 As Integer
Public 乱数名 As String
Public 区間 As Integer
Dim λ As Single
Dim i As Integer

Sub ポアソン乱数発生()
    Randomize

    Dim 乱数順位 As Integer
        
    乱数名 = "ポアソン乱数"
    
    Call 前回データを削除
    
    乱数の数 = Range("A3").Value
    λ = Range("K4").Value
    
    If λ <> Int(λ) Then
        MsgBox "λ(単位時間のイベント数(到着率))は、整数にして下さい。" & Chr(13) & _
        "小数を入力した場合は、小数点以下を切り捨てて処理します。"
        λ = Int(λ)
    End If

    If λ <= 0 Then
        MsgBox "λ(単位時間のイベント数(到着率))は、正数にして下さい。"
        End
    End If

    For 乱数順位 = 1 To 乱数の数
        Range("A11").Cells(乱数順位, 1).Value = ポアソン乱数(λ)
        Range("A11").Cells(乱数順位, 1).NumberFormat = "#,##0_ "
    Next 乱数順位
    
    If λ < 2 Then
        区間 = λ * 10 '到着率が小さいときは、右に長くなるので、データ区間を到着率の10倍とする。
    ElseIf λ < 5 Then
        区間 = λ * 4
    ElseIf λ < 15 Then
        区間 = λ * 3
    Else
        区間 = λ * 2  '到着率が大きいときは、左右対象になるため、データ区間は2倍でよい。
    End If

    For i = 0 To 区間 - 1
        Range("B13").Cells(i, 1).Value = i
    Next i

    Call ヒストグラム区間指定(乱数の数, 区間, 乱数名)

    Call Excelポアソン分布関数(λ)

End Sub

Function ポアソン乱数(λ As Single) As Integer
    Dim t1 As Single
    
    ポアソン乱数 = 0
    t1 = 指数乱数(1)
    Do While t1 < λ
        ポアソン乱数 = ポアソン乱数 + 1
        t1 = t1 + 指数乱数(1)
    Loop
End Function

Sub Excelポアソン分布関数(λ)
    Range("F1").Cells(11, 1).Value = "参考Excel関数"
    For i = 12 To Cells(ActiveSheet.Rows.Count, 3).End(xlUp).Row - 1
        Range("F1").Cells(i, 1).Value = _
        WorksheetFunction.Poisson(Range("C1").Cells(i, 1).Value, λ, 1) * 100
        Range("F1").Cells(i, 1).NumberFormat = "#,##0.00_ "
    Next i
End Sub


★★★ポアソン乱数2モジュール★★★
Option Explicit

'ポアソン乱数2
Public 乱数の数 As Integer
Public 乱数名 As String
Public 区間 As Integer
Dim λ As Single
Dim i As Integer

Sub ポアソン乱数発生2()
    Randomize

    Dim 乱数順位 As Integer
        
    乱数名 = "ポアソン乱数2(離散型)"

    Call 前回データを削除

    乱数の数 = Range("A3").Value
    λ = Range("K4").Value
    
    If λ <> Int(λ) Then
        MsgBox "λ(単位時間のイベント数(到着率))は、整数にして下さい。" & Chr(13) & _
        "小数を入力した場合は、小数点以下を切り捨てて処理します。"
        λ = Int(λ)
    End If

    If λ <= 0 Then
        MsgBox "λ(単位時間のイベント数(到着率))は、正数にして下さい。"
        End
    End If

    For 乱数順位 = 1 To 乱数の数
        Range("A11").Cells(乱数順位, 1).Value = ポアソン乱数2(λ)
        Range("A11").Cells(乱数順位, 1).NumberFormat = "#,##0_ "
    Next 乱数順位
    
    If λ < 2 Then
        区間 = λ * 10 '到着率が小さいときは、右に長くなるので、データ区間を到着率の10倍とする。
    ElseIf λ < 5 Then
        区間 = λ * 4
    ElseIf λ < 15 Then
        区間 = λ * 3
    Else
        区間 = λ * 2  '到着率が大きいときは、左右対象になるため、データ区間は2倍でよい。
    End If

    For i = 0 To 区間 - 1
        Range("B13").Cells(i, 1).Value = i
    Next i

    Call ヒストグラム区間指定(乱数の数, 区間, 乱数名)

    Call Excelポアソン分布関数(λ)

End Sub

Function ポアソン乱数2(λ As Single) As Integer
                                           '関数 ポアソン乱数2（平均 λ)
    Dim V As Single, Vlimit As Single      '変数宣言 積 V, 積下限 Vlimit

    ポアソン乱数2 = 0
    V = 1
    Vlimit = Exp(-λ)         'ポアソン乱数2←0, 積 V ←1, 積下限 Vlimit ←Exp(-λ)
    Do                              'Do - Loop までの間の文を繰り返す
        V = V * Rnd()                  '積 V ← V×[0,1]一様乱数
        If V < Vlimit Then Exit Do     'V<Vlimitなら Do-Loop を終了しLoop後の文に処理を移す
        ポアソン乱数2 = ポアソン乱数2 + 1
    Loop                               'Do - Loop 文の終わり
End Function




★★★グラフ作成モジュール★★★
Option Explicit

Public グラフ名 As String
Dim グラフ�� As Integer

Sub ヒストグラム区間指定(乱数の数, 区間, 乱数名)

    If 区間 = 0 Then

     Application.Run "ATPVBAEN.XLA!Histogram" _
        , ActiveSheet.Range("A11").Resize(乱数の数, 1) _
        , ActiveSheet.Range("C11") _
        , , False, True, True, False 'Excelの「分析ツール-VBA」を使って、ヒストグラムを表示する。

'Excel2007の場合は、 この上下2行に有る、ATPVBAEN.XLA! を ATPVBAEN.XLAM! と、4桁拡張子に変更して下さい。

    Else

     Application.Run "ATPVBAEN.XLA!Histogram" _
        , ActiveSheet.Range("A11").Resize(乱数の数, 1) _
        , ActiveSheet.Range("C11") _
        , ActiveSheet.Range("B12").Resize(区間, 1), False, True, True, False
        'グラフの横軸を整数にしたい場合は、明示的に整数のデータ区間を指定しています。

    End If

    グラフ名 = ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Name
    ActiveSheet.ChartObjects(グラフ名).Activate
    
    ActiveChart.ChartTitle.Select
    Selection.Characters.Text = 乱数名 & "ヒストグラム" 'グラフ名に、乱数名を追加する。
    
    ActiveChart.Axes(xlCategory).Select
    With Selection.TickLabels     '軸の目盛ラベルを選択します。
'       .Alignment = xlCenter  古いExcelでも動くように削除
'       .Offset = 100  古いExcelでも動くように削除
        .ReadingOrder = xlContext
        .Orientation = xlDownward '横軸のラベル文字列の向きを-90設定します。
    End With

    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes(グラフ名).ScaleHeight 2, msoFalse, msoScaleFromTopLeft
     'グラフを縦方向に拡大する。
    
    With ActiveChart.Axes(xlCategory)
        .HasMajorGridlines = False
        .HasMinorGridlines = False
    End With
    With ActiveChart.Axes(xlValue)
        .HasMajorGridlines = True   '項目軸の目盛線の表示を追加します。
        .HasMinorGridlines = False
    End With
    
    ActiveChart.SeriesCollection(1).Select
    With ActiveChart.ChartGroups(1)
        .Overlap = 0
        .GapWidth = 10              'グラフの棒の幅を広くします
        .HasSeriesLines = False
        .VaryByCategories = False
    End With

    ActiveWindow.Visible = False
    Worksheets("Sheet1").Activate
    Range("A3").Select

End Sub


★★★セル行削除モジュール★★★
Option Explicit

Sub 前回データを削除()
    Dim 最終行 As Long
    Dim i As Integer

    '入力パラメータのチェック
    If Range("A3").Value > 30000 Then
        MsgBox "A3セルに入力された、発生させる乱数の数が大きすぎます。" & Chr(13) & _
        "30,000未満に修正して下さい。" & Chr(13) & _
        "パソコンの性能にもよりますが、1,000個程度が適当です。"
        End
    End If

    Worksheets("sheet1").ChartObjects.Delete 'まず全てのグラフを削除します。

    最終行 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
    
    Application.ScreenUpdating = False '処理速度を上げるため、画面表示の更新を止めます。
'   Application.Calculation = xlCalculationManual  Excelの古いバージョンでは使えないので削除

    Range(Range("A11"), Range("A11").End(xlDown)).Select  'A列の最後まで、行削除
    Selection.EntireRow.Delete

     'C列のデータ行数がA列より大きい場合にも対応
    Range(Range("C11"), Range("C11").End(xlDown)).Select
    Selection.EntireRow.Delete

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    Range("A3").Select
End Sub



★★★マウスポインタ モジュール★★★
Option Explicit

'マウスがボタンの上に来たときに、マウスポインタを手(指)の形にする

Public rcLC As Long      'マウスカーソルの戻り値(形状) 格納用

Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" _
    (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Public Declare Function SetCursor Lib "user32" _
    (ByVal hCursor As Long) As Long

Public Const IDC_HAND = 32649&        'ハンドカーソル

Option Explicit

'03：2021/05/28：問題が重複しないように連想配列を追加
'04：2021/08/08：実戦に役立つよう、引き算の被減数に180が多く出るように

Sub 数の暗黙知能力向上プリント生成()

   Dim 計算方法 As String
   Dim 処理行 As Integer
   Dim 処理列 As Integer
   Dim 数左 As Integer
   Dim 数右 As Integer
   Dim 答 As Integer
   Dim 問題 As String
   Dim 回答 As String
   Dim 開始日時 As Variant
   Dim 終了日時 As Variant
   Dim 回答索引 As Object 'Scripting.Dictionary オブジェクト
  '★重複問題が発生しないように回答をベースに索引を作成★
   Set 回答索引 = CreateObject("Scripting.Dictionary") '★連想配列の定義
   Dim ループカウンタ As Integer
   
   Randomize ' 乱数生成器を初期化します。
   開始日時 = Now
   ループカウンタ = 0
   
   '加減算
   For 処理列 = 1 To 3 Step 2
      For 処理行 = 1 To 10
         計算方法 = CStr(乱数(1, 2))
         If 計算方法 = "1" Then '★★★足し算★★★
            Do
               If 処理行 < 6 Then
                  数左 = 乱数(1, 50)  '左側 5行目までは 50までの数しか出現しない
               Else
                  数左 = 乱数(1, 100) '左側 6行目以降は 100までの数が出現する
               End If
               数右 = 乱数(5, 50) '右側の数は 50までの数しか出現しない
               答 = 数左 + 数右
            Loop While 答 >= 300  '結果が 300以下になるように制限
            
               問題 = Space(4 - Len(CStr(数左))) & CStr(数左) & " ＋ " _
                     & Space(3 - Len(CStr(数右))) & CStr(数右)
               回答 = "'= " & Space(3 - Len(CStr(答))) & CStr(答)

         Else '★★★引き算★★★
            Do
               If 処理行 < 6 Then
                  数左 = 乱数(1, 100)  '左側 5行目までは 100までの数しか出現しない
               Else
                  数左 = 乱数(1, 300) '左側 6行目以降は 300までの数が出現する
                  If 数左 < 180 Then
                     数左 = 180
                  End If
               End If
               数右 = 乱数(5, 100) '引く数は 100までの数しか出現しない
               答 = 数左 - 数右
            Loop While 答 < 7 Or 答 > 200 '結果が 200以下になるように制限
            
            問題 = Space(4 - Len(CStr(数左))) & CStr(数左) & " − " _
                  & Space(3 - Len(CStr(数右))) & CStr(数右)
            回答 = "'= " & Space(3 - Len(CStr(答))) & CStr(答)

         End If
         
         If 回答索引.Exists(答) = False Then
            '★新規回答の場合
            ThisWorkbook.Worksheets("回答").Range("A2").Cells(処理行, 処理列).Value = 問題
            ThisWorkbook.Worksheets("問題").Range("A2").Cells(処理行, 処理列).Value = 問題
            ThisWorkbook.Worksheets("回答").Range("B2").Cells(処理行, 処理列).Value = 回答
            回答索引(答) = "既存"
         Else
            '★既存回答の場合
            処理行 = 処理行 - 1
            ループカウンタ = ループカウンタ + 1
            If ループカウンタ > 1000 Then
               MsgBox "ループカウンタ= " & ループカウンタ
               Stop
            End If
         End If
         
      Next 処理行
   Next 処理列

   '★★★掛算★★★
   For 処理行 = 1 To 5
'   Stop
      Do
         If 処理行 < 3 Then
            数左 = 乱数(9, 20)  '掛けられる数 2行目までは 20までの数しか出現しない
         Else
            数左 = 乱数(9, 50)  '掛けられる数 3行目までは 50までの数しか出現しない
         End If
         数右 = 乱数(2, 9)      '掛ける数 2〜9 の数しか出現しない
         答 = 数左 * 数右
      Loop While 答 >= 300 Or 答 < 10   '結果が 300以下になるように制限
      
      問題 = Space(4 - Len(CStr(数左))) & CStr(数左) & " × " _
            & Space(3 - Len(CStr(数右))) & CStr(数右)
      回答 = "'= " & Space(3 - Len(CStr(答))) & CStr(答)
      
      If 回答索引.Exists(答) = False Then
         '★新規回答の場合
         ThisWorkbook.Worksheets("回答").Range("A13").Cells(処理行, 1).Value = 問題
         ThisWorkbook.Worksheets("問題").Range("A13").Cells(処理行, 1).Value = 問題
         ThisWorkbook.Worksheets("回答").Range("B13").Cells(処理行, 1).Value = 回答
         回答索引(答) = "既存"
      Else
         '★既存回答の場合
         処理行 = 処理行 - 1
         ループカウンタ = ループカウンタ + 1
         If ループカウンタ > 1000 Then
            MsgBox "ループカウンタ= " & ループカウンタ
            Stop
         End If
      End If
      
   Next 処理行
      
   '★★★割算★★★
   For 処理行 = 1 To 5
'   Stop
      Do
         数右 = 乱数(2, 9) '割る数は 2〜9 になる
         答 = 乱数(3, 9)  '割り数の答は 3〜9 になる
         数左 = 数右 * 答
      Loop While 数左 > 101 '割られる数 100より大きくならないように
      
      問題 = Space(4 - Len(CStr(数左))) & CStr(数左) & " ÷ " _
            & Space(3 - Len(CStr(数右))) & CStr(数右)
      回答 = "'= " & Space(3 - Len(CStr(答))) & CStr(答)
      
      If 回答索引.Exists(答) = False Then
         '★新規回答の場合
         ThisWorkbook.Worksheets("回答").Range("C13").Cells(処理行, 1).Value = 問題
         ThisWorkbook.Worksheets("問題").Range("C13").Cells(処理行, 1).Value = 問題
         ThisWorkbook.Worksheets("回答").Range("D13").Cells(処理行, 1).Value = 回答
         回答索引(答) = "既存"
      Else
         '★既存回答の場合
         処理行 = 処理行 - 1
         ループカウンタ = ループカウンタ + 1
         If ループカウンタ > 1000 Then
            MsgBox "ループカウンタ= " & ループカウンタ
            Stop
         End If
      End If
      
   Next 処理行

   Set 回答索引 = Nothing '★連想配列を削除
   終了日時 = Now
   MsgBox "処理時間は、" _
   & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"

End Sub


'' [最初, 最後]、つまり {最初 <= x <= 最後} の範囲の乱数を発生させる関数
Function 乱数(最初 As Integer, 最後 As Integer) As Integer
   'Rnd 関数は、0 以上 1 未満の値を返します。
   乱数 = Int(Rnd * (最後 - 最初 + 1)) + 最初
   'Int は、number の小数部分を取り除いて、その結果得られる整数値を返します。
End Function