本
問題点
本著には以下でマクロ付エクセルがダウンロードできますが、最新のバージョンのエクセルで開くとマクロが全て消えているという問題があります。
きんざいSTORE『モンテカルロ法入門』
※本著に記載されているアドレスと変わっているので注意。現在は上記のリンクが正しいアドレスです
しかも出て来るエラー表示が以下なので「マクロが無効になっているせいか？」と勘違いしてしまいます。※本著に従ってちゃんとマクロを有効にしても以下のエラーが出ます
これはエクセルのバーションが変わり拡張子が変更（xls→xlsm）になった事が原因です。
そして、xlsmに変換してもマクロは消えたままです。
一度開いた時点で消えるので、それから変換しても消えたままなのだと考え、エクセルを開かずにxls→xlsm変換も試しましたがマクロは消えたままでした。
私はマクロを本著の通り手書きする事で対応しましたが、本著で私同様困っている人のためにマクロ部分のソースを公開します。コピペしてご使用下さい。
前準備
ダウンロードした拡張子xlsのエクセルファイルを開いてメニューの「ファイル」→「名前を付けて保存」→拡張子で「Excel マクロ有効ブック(*.xlsm)」を選択→「保存」ボタン押下
新しく出来た拡張子xlsmのエクセルファイルを開く
VBAエディタを開き後述のソースコードを標準モジュールのModule1にコピペする
ソースコード
※自分で記述したのだけ載せています
第3章 モンテカルロ円周率
Option Explicit
Sub モンテカルロ円周率()
Dim サンプル数 As Long, X As Double, Y As Double
Dim 原点からの距離 As Double, 円の中の数 As Long
Dim 推定円周率 As Double, i As Long
Randomize
サンプル数 = Range("C6").Value
円の中の数 = 0
For i = 1 To サンプル数
X = Rnd()
Y = Rnd()
原点からの距離 = Sqr(X ^ 2 + Y ^ 2)
If 原点からの距離 <= 1 Then 円の中の数 = 円の中の数 + 1
Next i
推定円周率 = 4 * 円の中の数 / サンプル数
Range("D6") = 推定円周率
End Sub
Sub モンテカルロ円周率グラフ()
Const サンプル数 = 5000
Dim X As Double, Y As Double
Dim 原点からの距離 As Double, 円の中の数 As Long
Dim 推定円周率 As Double, i As Long
Dim 円中RowNo As Integer, 円外RowNo As Integer
Randomize
Range("B49:E5048").ClearContents
円の中の数 = 0
円中RowNo = 49
円外RowNo = 49
For i = 1 To サンプル数
X = Rnd()
Y = Rnd()
原点からの距離 = Sqr(X ^ 2 + Y ^ 2)
If 原点からの距離 < 1 Then
円の中の数 = 円の中の数 + 1
Cells(円中RowNo, 2) = X
Cells(円中RowNo, 3) = Y
円中RowNo = 円中RowNo + 1
Else
Cells(円外RowNo, 4) = X
Cells(円外RowNo, 5) = Y
円外RowNo = 円外RowNo + 1
End If
Range("A44") = i
推定円周率 = 4 * 円の中の数 / i
Range("A45") = 推定円周率
Application.Wait [Now() + "0:00:00.01"]
DoEvents '本書にはなかったがグラフの描画更新（アニメーション）には必要
Next i
End Sub
第5章 千鳥足
●基本
Option Explicit
Sub グラフY軸設定(ByVal グラフ番号 As Integer, _
ByVal 上限値 As Double, _
ByVal 下限値 As Double)
With ActiveSheet.ChartObjects(グラフ番号) _
.Chart.Axes(xlValue)
.MaximumScale = 上限値
.MinimumScale = 下限値
End With
End Sub
Sub 千鳥足()
Const 歩行数 = 30
Dim 道の方向 As Double, アニメーション As Boolean
Dim 現在地 As Double, Y軸上限値 As Double
Dim Y軸下限値 As Double, 一様乱数 As Double, i As Integer
Randomize
Range("C39:D68").ClearContents
道の方向 = Range("D31").Value
アニメーション = Range("D32").Value
Y軸上限値 = Range("D33").Value
Y軸下限値 = Range("D34").Value
Call グラフY軸設定(1, Y軸上限値, Y軸下限値)
現在地 = 0
For i = 1 To 歩行数
一様乱数 = Rnd()
If 一様乱数 <= 0.4 Then '0.4の確率で右へふらつく
現在地 = 現在地 + 道の方向 - 1
ElseIf 一様乱数 <= 0.6 Then '0.2の確率でまっすぐ
現在地 = 現在地 + 道の方向
Else '0.4の確率で左へふらつく
現在地 = 現在地 + 道の方向 + 1
End If
Cells(38 + i, 3) = i
Cells(38 + i, 4) = 現在地
If アニメーション Then
'速すぎないように、一歩ごとに0.5秒間ストップする
Application.Wait [Now() + "0:00:00.05"]
DoEvents '本書にはなかったがグラフの描画更新（アニメーション）には必要
End If
Next i
End Sub●泥酔
Sub グラフXY設定(ByVal グラフ番号 As Integer, _
ByVal X上限値 As Double, _
ByVal X下限値 As Double, _
ByVal Y上限値 As Double, _
ByVal Y下限値 As Double)
With ActiveSheet.ChartObjects(グラフ番号) _
.Chart.Axes(xlCategory)
.MaximumScale = X上限値
.MinimumScale = X下限値
End With
With ActiveSheet.ChartObjects(グラフ番号) _
.Chart.Axes(xlValue)
.MaximumScale = Y上限値
.MinimumScale = Y下限値
End With
End Sub
Sub 泥酔千鳥足()
Const 歩行数 = 1000
Dim 道の方向 As Double, アニメーション As Boolean
Dim 現在地X As Double, 現在地Y As Double
Dim X軸上限値 As Double, X軸下限値 As Double
Dim Y軸上限値 As Double, Y軸下限値 As Double
Dim i As Integer
Randomize
Range("C39:E1038").ClearComments
アニメーション = Range("D30").Value
X軸上限値 = Range("D31").Value
X軸下限値 = Range("D32").Value
Y軸上限値 = Range("D33").Value
Y軸下限値 = Range("D34").Value
Call グラフXY設定(1, X軸上限値, X軸下限値, _
Y軸上限値, Y軸下限値)
現在地X = 0
現在地Y = 0
For i = 1 To 歩行数
Select Case Rnd() '一様乱数
Case Is < 0.25: 現在地X = 現在地X - 1 '右へ
Case Is < 0.5: 現在地X = 現在地X + 1 '左へ
Case Is < 0.75: 現在地Y = 現在地Y + 1 '前へ
Case Is < 1: 現在地Y = 現在地Y - 1 '後へ
End Select
Cells(38 + i, 3) = i
Cells(38 + i, 4) = 現在地X
Cells(38 + i, 5) = 現在地Y
If アニメーション Then
'速すぎないように、一歩ごとに0.1秒間ストップする
Application.Wait [Now() + "0:00:00.1"]
End If
Next i
End Sub
