Excel VBA 確率

Excel VBA のトップに戻る
Excel VBA 目次

乱数を使う(円周率 Monte Carlo simulation)
指定範囲の整数乱数を発生する関数
正規乱数・二項乱数・指数乱数・ポアソン乱数を発生
数の暗黙知能力向上プリント

索引

乱数を使う(円周率 Monte Carlo simulation)

 吉村忠与志さんの「厳選例題 Excelで解く 問題解決のための科学計算入門」に掲載されていた事例から、一つだけ紹介します。

 グラフ作成の部分は、Excelの「マクロの記録」機能を使って、VBAコードを生成しました。
 ワークシートにグラフを埋め込むと、グラフが配置される場所は、表示されている画面の中央付近になります。
 グラフを、セルの場所を指定して、作りたい場合は、ChartObjects コレクションオブジェクトに対してAddメソッドを使います。
 詳しくは、シートの位置を指定して、複数の領域を含む、複数のグラフを表示 の項を参照下さい。

 下のマクロをダウンロードできます。→MonteCarlo.xls

 参考:「点の数と近似値の誤差」については、下の1.4を参照下さい。
http://www.math.sci.hiroshima-u.ac.jp/~m-mat/TEACH/keisan-1.pdf
モンテカルロ法によるπの算出過程
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

 解説:
 Rnd 関数は、 0 以上、1 未満の範囲の値で、等しい確率の、単精度浮動小数点数型 (Single) の乱数を返します。一様乱数と言います。

構文
Rnd[(number)]
引数 number は省略可能です。引数 number には、単精度浮動小数点数型 (Single) の数値または任意の有効な数式を指定します。

number の値戻り値
< 0常に、引数 number のシード値によって決まる同じ数値を返します。
> 0乱数系列の次の乱数を返します。
= 0直前に生成した乱数を返します。
省略したとき乱数系列の次の乱数を返します。


 Randomize ステートメントは、乱数ジェネレータを初期化 (乱数系列を再設定) する数値演算ステートメントです。

 Randomize ステートメントを使用しない場合、引数を指定しないで Rnd 関数を呼び出すと、最初に Rnd 関数を呼び出したときのシード値と同じ値が使用されます。それ以降は、直前に生成された数がシード値として使用されます。
 Randomize ステートメントを使用すると、システム タイマーから取得した値を新しいシード値として乱数を発生します。


 HasTitle プロパティは、グラフのタイトル表示を制御します。True の場合、軸やグラフのタイトルを表示します。ブール型 (Boolean) の値を使用します。

この種類の目次に戻る↑ 索引へ↓ トップページに戻る


指定範囲の整数乱数を発生する関数

 サイコロなどを模倣するときなどに使える関数です。

 下のマクロをダウンロードできます。→RandomValueCheckVBA01.xls

 試行回数 が 10000 回だと均一な分布になりますが、100 回程度だと正常範囲でしょうが偏りが見えるものですね。

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


この種類の目次に戻る↑ 索引へ↓ トップページに戻る


正規乱数・二項乱数・指数乱数・ポアソン乱数を発生

 上で一様乱数の関数を使ったついで(・・・)に、他の乱数の発生方法を紹介します。

 統計分析では、その目的とする確率分布に従う乱数を使ってシミュレーションします。
 ここでは、代表的な4つの乱数(正規乱数二項乱数指数乱数ポアソン乱数)を発生させて、ヒストグラムで、その分布の形を確認します。
 また、Excelの関数で計算した累積確率と、結果を対比させます。

 以下のVBAコードは、縄田和満さんの「Excel VBAによる統計統計データ解析入門」のコードを使わせていただきました。プログラムの乱数発生部分の解説は、この書籍をお買い求めになるか、図書館などで閲覧して下さい。

 このマクロでは、ヒストグラムを表示するために、Excelの「分析ツール-VBA」を使っています。「分析ツール-VBA」は、Excelで統計や技術計算に基づく分析を実行するための、アドイン機能です。
 [ツール] メニューに [分析ツール-VBA] が表示されない場合は、[ツール] メニューの[アドイン]で表示されるリストボックスの [分析ツール-VBA] にチェックを入れて、プログラムをインストールして下さい。
 Vista の場合は、「ファイル」→「Excelのオプション」で表示される、下の画面で、「設定」ボタンを押します。
Excel2007のアドイン
 すると、リストボックスが表示されます。
分析ツール-VBAを選択
 このマクロでは、Excelのバージョンを取得して、[分析ツール-VBA] の拡張子を、自動で変更するようにしています。
 Excel2003 以前は、ATPVBAEN.XLA!Histogram だったものが、
Excel2007〜は、ATPVBAEN.XLAM!Histogram と、4桁拡張子に変更しているからです。
 Microsoft 社は、なぜこんなところを変更する! 強い怒り!!

 下のマクロをダウンロードできます。→RandomNumbersVBA3.xls
 (この「乱数発生」は、[分析ツール-VBA] を使っているためか、ブラウザの画面で開いた状態では実行できません。いったんダウンロードして、Excel で開いて、実行して下さい。
 使い方は、いずれかの「乱数」のボタンを押すだけです。何度でも、押せます。)



 マクロの利用方法の例:

@さいころを10回振って、1の出る回数は?
→ 二項乱数で、確率を1/6、回数を10として実行します。

A一日平均5通のメイルが来る人が、全くメイルを受け取らない日は、月の内何日?
メイルを10通以上受け取る日は何日?
→ ポアソン乱数で、平均到着率を5で実行します。

 ★ コラム ★
 車で高速道路を走っていて、インターチェンジでの車の出入りが無いのに、上り坂の途中や、トンネルの入り口手前で、渋滞して、止まりそうになることがありますね。
 そのくせ、しばらく行くと、狐につままれたように、渋滞が解消して、車間距離を空けて、高速で走れるようになります。

 これは、待ち行列ではなく、単位時間あたりの処理能力の問題です。

 時速を秒速に直して比較してみましょう。

 時速(100km)=秒速(28m)
 時速( 4km)=秒速( 1m)

 時速100kmで走っているときは、1秒間に28m走れますが、歩いているくらいに遅くなると、1秒間に1mしか走れません。
 車の長さを 5m とすると、スピードが遅くなると、秒速 1m x 5 = 5m で、車が数珠つなぎ状態になってしまう交通量でも、時速100kmだと 秒速 28m x 5 = 135m で、充分な車間距離をおいて走れるのです。

 この事実から言えることは、高速道路の途中で渋滞しているときには、渋滞の後ろで
「この先渋滞中!速度落とせ!」
という掲示を出すのは逆効果で、渋滞の列がどんどん長くなってしまう可能性があります。
 むしろ、渋滞の先頭部分に、
「後続車か渋滞しています。もっとスピードを上げて走りましょう!」
という警告を表示すべきなのです。
(^^)/~~~
 統計データ解析の詳しい方法については、下記のサイトを、ご欄下さい。
(^^ゞ
★統計データ解析★上智大学★
http://econom01.cc.sophia.ac.jp/sda/
http://web.archive.org/web/20090225213505/http://econom01.cc.sophia.ac.jp/sda/
「sda-trial.xls」のシート「スロットマシン」の「乱数の簡単な応用例」は、やり過ぎないように!
 ポアソン乱数発生2モジュールは、このサイトのコードを使わせていただきました。
 また、「待ち行列のシミュレーション」のコードをベースに、アニメーション風にアレンジしたものを、RandomNumbersVBA3.xls のシート「待ち行列」に、おまけ(・・・)に付けました。
(「待ち行列」は、ブラウザで開いた状態でも、simulate ボタンを押すと、動きます。)


追記: Excel の「コントロールツールボックス」の「コマンドボタン」にマクロを登録したとき、マウスポインタをボタンに重ねても、ポインタの形は矢印のままで、手(指)の形にはなりません。
 ここでは、下のサイトを参考にさせていただき、MouseMoveイベントで、手の形になるようにしました。
 (更に調べたところ、「フォーム」の「ボタン」を使うと、既定で手の形になることが分りました。)

★Access Home Page★
http://www.nurs.or.jp/~ppoy/access/
http://www.nurs.or.jp/~ppoy/access/access/acF026.html



 関連ですが、音楽の世界では、ピンクノイズと呼ばれる周波数分布の「乱数(ノイズ)」が使われます。

 ノイズには、あらゆる周波数成分を一様に含むホワイトノイズ(白色雑音 white noise 1Hzごとの音のエネルギーが等しい)と、周波数に反比例して、高い周波数の音ほど弱くなるピンクノイズ(pink noise または1/f雑音 1オクターブごとのエネルギーが等しい)が有ります。
 光に例えると、すべての波長の光を含む光が白色光で、周波数が低い(波長が長い)成分は、赤い光なので、低い周波数のレベルが大きければ、白色より赤みがかっているということでピンクと表現したものです。

 ホワイトノイズの例は、テレビの放送終了後の、画面が「砂嵐」状態のときの音や、FM放送の局間ノイズで、「シャー…」と聞こえるものです。機械的に発生させやすいノイズです。

 人間の耳は、周波数に対して(音量に対しても)対数的に感じるようにできています。音程のオクターブの違いは、人間の耳には等間隔に聞こえますが、周波数でオクターブの違いは、周波数の比率が2倍になっています。(100Hz→200Hz→400Hz→800Hz・・)
 ピンクノイズは、この人間の耳の特性を基準に考えられたもので、聴感上はホワイトノイズよりも低音域が勝っているので、「ザー…」と聞こえます。音響製品の周波数特性の評価には、このピンクノイズが使われます。ホワイトノイズを、-3dB/oct の低域通過フィルタ(Low Pass Filter)に通して作り出します。(ピンクノイズ・ジェネレータ)



★★★ 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&        'ハンドカーソル


 解説:
 Function ステートメントは、Function プロシージャの名前、引数、および本体部分を構成するコードを宣言します。

構文
[Public | Private | Friend] [Static] Function name [(arglist)] [As type]

[statements]
[name = expression]
[Exit Function]
[statements]
[name = expression]

End Function

 name 必ず指定します。定義する Function プロシージャの名前を指定します。変数の標準的な名前付け規則に従って指定します。

 引数 arglist は、次の形式で指定します。
[Optional] [ByVal | ByRef] [ParamArray] varname[( )] [As type] [= defaultvalue]


 引数の値渡しByVal と、参照渡しByRef の違い
http://shuhho.hatenablog.com/entry/excelvba-37★
http://officetanaka.net/excel/vba/tips/tips94.htm
http://msdn2.microsoft.com/ja-jp/library/eek064h4(VS.80).aspx

 ByRef :参照渡し
 すべての引数は、特に指定しない限り、参照渡しでFunction プロシージャ、Sub プロシージャに引き渡されます。
 デフォルトの渡し方です。

 参照渡しを使うと、呼び出し元のコードにある、基のプログラミング要素を、プロシージャから直接参照できるようにします。

 Sub で引数を渡すときは、戻り値がほしいためなので、参照渡し(無指定のまま)を使う場合が多いでしょう。
 メイン処理から、Call した Sub のプロシージャに渡した変数を、Sub で加工してもらって、メインに戻してもらう場合が、参照渡しです。
 参照渡しは、引数のデータ型に関係なく、すべての引数が渡されるときの所要時間およびプロシージャ内のメモリ領域 (4 バイト) が同じであるため、効率的です。

 ByVal :値渡し

 値渡し (値による引き渡し) を使用すると、元の変数(基になるプログラミング要素)の値を、プロシージャ内のローカル変数にコピーします。
 プロシージャ コードから呼び出し元のコードにある、基の要素にアクセスすることはありません。
 したがって、呼び出されたプロシージャ内で渡された変数の値を変更しても、呼び出し側のプロシージャが参照する元の変数の値は変更されません。

 値で渡される引数は、引数のデータ型に応じて、プロシージャ内で 2 〜 16 バイトのメモリ領域を使用します。
 データ型が大きいほど、値渡しに要する時間が少し長くなります。

 引数を値渡しで渡すには、プロシージャ定義内で対応するパラメータに ByVal キーワードを指定します。

 Function のデフォルトは、「参照渡し」です。
 文字列型変数は、データ量が多くなるので、Function 内で戻り値を変更しないことが明らかな文字列型変数は場合に限っては、デフォルトの「参照渡し」のままで良いです。このほうが、メモリも少なく、処理速度も速くなります。

 しかし、引数を Function 内で変更する場合は、ByVal を明示的に指定して、メイン処理と分離する必要があります。
 ByVal (値渡し) することで、メイン処理の変数の値が、Function 内で変えられても、メイン処理に影響を与えることはなくなります。

 逆に言えば、デフォルトの「参照渡し」を使う場合は、Function 内で引数の値を変えない工夫 が必要です。



 Application プロパティは、オブジェクトを返すプロパティです。
 対象となるオブジェクトが指定されない場合は、Excel アプリーション (Application オブジェクト) を返します。
 対象となるオブジェクトが指定された場合は、指定されたオブジェクトを作成した Application オブジェクトを返します。OLE オートメーションを使っていて、オブジェクトのアプリケーションにアクセスするときなどに、このプロパティを使います。値の取得のみ可能です。


 NormSInv は、Excel の関数で、標準正規分布の累積分布関数の逆関数の値を返します。
 この分布は、平均が 0 で標準偏差が 1 である正規分布に対応します。

 NormSInv(確率)
 確率 正規分布における確率を指定します。

注意:
 確率に数値以外の値を指定すると、エラー値 #VALUE! が返されます。
 確率 < 0、または確率 > 1 である場合、エラー値 #NUM! が返されます。
 確率の値が指定されると、NORMSDIST(z) = 確率となるような値 z がシークされます。したがって、NORMSINV 関数の精度は NORMSDIST 関数の精度に依存します。NORMSINV 関数では、反復計算の手法が利用されます。100 回反復計算を繰り返しても計算結果が収束しない場合、エラー値 #N/A が返されます。


 NormDist は、指定した平均と標準偏差に対する正規分布関数の値を返します。
 この関数は、仮説検定を始めとする統計学の幅広い分野に応用できます。

 NormDist(x,平均,標準偏差,関数形式)

 x 関数に代入する値を指定します。
 平均 対象となる分布の算術平均 (相加平均) を指定します。
 標準偏差 対象となる分布の標準偏差を指定します。
 関数形式 計算に使用する指数関数の形式を論理値で指定します。関数形式に TRUE を指定すると累積分布関数の値が計算され、FALSE を指定すると確率密度関数の値が計算されます。

注意:
 平均、標準偏差に数値以外の値を指定すると、エラー値 #VALUE! が返されます。
 標準偏差 <= 0 である場合、エラー値 #NUM! が返されます。
 平均 = 0 、標準偏差 = 1 かつ関数形式 = TRUE である場合、標準正規分布関数 (NORMSDIST 関数) の値が計算されます。

 NormSDist は、標準正規分布の累積分布関数の値を返します。
 この分布は、平均が 0 (ゼロ) で標準偏差が 1 である正規分布に対応します。正規分布表の代わりにこの関数を使用することができます。

 BinomDist は、二項分布の確率関数の値を返します。
 この関数は、一定回数の試行を伴う問題の中で、試行の結果が成功または失敗のいずれかである場合、試行が独立したものである場合、かつ実験を通して成功の確率が一定である場合に使用します。
 たとえば、次に生まれる 3 人の赤ちゃんの中で 2 人が男の子である確率を計算することができます。

 BinomDist(成功数,試行回数,成功率,関数形式)

 成功数 試行回数に含まれる成功の回数を指定します。
 試行回数 独立試行の回数を指定します。
 成功率 1 回の試行が成功する確率を指定します。
 関数形式 関数の形式を、論理値で指定します。関数形式に TRUE を指定した場合、BINOMDIST 関数の戻り値は累積分布関数となり、0 〜 成功数回の範囲で成功が得られる確率が計算されます。FALSE の場合は、確率密度関数となり、正確に成功数回の成功が得られる確率が計算されます。

 注意:
 成功数、試行回数に整数以外の値を指定すると、小数点以下が切り捨てられます。
 成功数、試行回数、成功率に数値以外の値を指定すると、エラー値 #VALUE! が返されます。
 成功数 < 0 または成功数 > 試行回数の場合、エラー値 #NUM! が返されます
 成功率 < 0 または成功率 > 1 の場合、エラー値 #NUM! が返されます。

 RoundUp 関数は、数値を指定された桁数に切り上げるExcelの関数です。
 WorksheetFunction プロパティを前に付ける必要が有ります。

 RoundUp(数値,桁数)
数値 切り上げの対象となる実数値を指定します。
桁数 数値を切り捨てた結果の桁数を指定します。

 ROUNDUP 関数は、ROUND 関数(四捨五入)に似た働きをしますが、常に数値の切り上げを行う点が異なります。
桁数に正の数を指定すると、数値は小数点の右 (小数点以下) の指定した桁に切り上げられます。
桁数に 0 を指定すると、数値は最も近い整数に切り上げられます。
桁数に負の数を指定すると、数値は小数点の左 (整数部分) の指定した桁 (1 の位を 0 とする) に切り上げられます。


 Round 関数は、指定された小数点位置で四捨五入した数値を返します。

 Round(expression [,numdecimalplaces])

expression 必ず指定します。四捨五入を行う数式を指定します。
numdecimalplaces 省略可能です。四捨五入を行う小数点以下の桁数を表す数値を指定します。省略すると、Round 関数は整数値を返します。
 ExcelのRound 関数は、この桁数に負の数を指定すると、数値は小数点の左側 (整数部分) の指定した桁 (1 の位を 0 とする) に四捨五入されます。しかし、VBAの関数では、負数は使えません。

例: Round(2.149, 2) とすると、2.149 を小数点第2位に四捨五入します (2.15)


 Int(number) 関数Fix(number) 関数は、どちらも引数 number の小数部分を取り除いた整数部分を返します。
 引数 number に負の値を指定した場合には、Int 関数が引数 number を超えない最大の負の整数を返すのに対して、Fix 関数は引数 number 以上の最小の負の整数を返します。
 たとえば、引数として -8.4 を指定すると、Int 関数は -9、Fix 関数は -8 をそれぞれ返します。
 Fix(number) は、次の数式と等価です。
Sgn(number) * Int(Abs(number))


 ExponDist 関数は、指数分布関数を返します。
 この関数は、銀行の ATM で現金を引き出すのにかかる時間など、イベントの間隔をモデル化する場合に使用します。
 たとえば、ある処理が 1 分以内に終了する確率を算出することができます。

 ExponDist(x,λ,関数形式)

x 関数に代入する値を指定します。
λ パラメータの値を指定します。
関数形式 計算に使用する指数関数の形式を論理値で指定します。関数形式が TRUE の場合、戻り値は累積分布関数となり、FALSE の場合は、確率密度関数が返されます。

 注意:
x またはλに数値以外の値を指定すると、エラー値 #VALUE! が返されます。
x <0 (負の数) を指定すると、エラー値 #NUM! が返されます。
λ <=0 である場合、エラー値 #NUM! が返されます。

 Poisson 関数は、ポアソン確率の値を返します。
 通常、ポアソン分布は一定の時間内に起きる事象の数を予測するために利用されます。
 たとえば、高速道路の料金所を 1 分間に通過する自動車の台数を予測することができます。

 Poisson(イベント数,平均,関数形式)
イベント数 生じる事象の数を指定します。
平均 一定の時間内に起きる事象の平均値を指定します。
関数形式 確率分布を計算する関数形式を、論理値で指定します。関数形式に TRUE を指定した場合、生起するランダムな事象の数が 0 からイベント数の範囲であるような累積ポアソン確率が計算されます。FALSE の場合は、生起する事象の数が正確にイベント数となるようなポアソン確率が計算されます。

 注意:
 イベント数に整数以外の値を指定すると、小数点以下が切り捨てられます。
 イベント数、平均に数値以外の値を指定すると、エラー値 #VALUE! が返されます。
 x < 0 の場合、エラー値 #NUM! が返されます。
 平均 <= 0 の場合、エラー値 #NUM! が返されます。



 IIf 関数は、式の評価結果によって、2 つの引数のうち 1 つを返します。

 IIf(expr, truepart, falsepart)

 IIf 関数の構文は、次の名前付き引数から構成されます。

指定項目内容
expr必ず指定します。評価対象の式を指定します。
truepart必ず指定します。名前付き引数 expr が真 (True) の場合に返す値または式を指定します。
falsepart必ず指定します。名前付き引数 expr が偽 (False) の場合に返す値または式を指定します。

 注意:
 IIf 関数では、名前付き引数 truepart または名前付き引数 falsepart のいずれか一方だけが返されますが、評価は両方の引数に対して行われます。
 このため、IIf 関数を使うと、予期しない結果が起きることがあります。たとえば、名前付き引数 falsepart を評価した結果 0 による除算エラーが発生する場合は、名前付き引数 expr が真 (True) であってもエラーが発生します。

 名前付き引数とは、オブジェクト ライブラリにあらかじめ定義された名前を持つ引数です。
 名前付き引数を使用すると、構文どおりに指定された順序で各引数に値を指定しなくても、任意の順序で値を設定することができます。
 たとえば、3 つの引数を取得できる次のようなメソッドがあるとします。
DoSomeThing namedarg1, namedarg2, namedarg3
 名前付き引数を使うと、次のように引数を指定することができます。
DoSomeThing namedarg3 := 4, namedarg2 := 5, namedarg1 := 20
 名前付き引数は、構文の標準的な配置順序で指定する必要はありません。

この種類の目次に戻る↑ 索引へ↓ トップページに戻る


数の暗黙知能力向上プリント

 テレビ・ドラマ「ドラゴン桜」で紹介されていた計算ドリルを生成するマクロを作ってみました。
 登場する数値の範囲を変えて、難易度を調整できます。

・算数 数学、勉強ができるかどうかは小2算数で決まる
・数の暗黙知を身につけるためにはスパルタが効果的
・数の暗黙知を身につける方法@「柳式 数の暗黙知能力向上プリント」

 下のマクロをダウンロードできます。→ MathWorkbookVBA04.xls

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

この種類の目次に戻る↑ 索引へ↓ トップページに戻る



ホームページのトップに戻る