素数を求めるマクロを

質問

走らすと暴走したようになり、素数＝１５１で止まります。
どこが悪いのでしょうか。正常に終わるようにしたいです。
======================
Sub 素数を求める()
　　Dim i As Long
　　Dim j As Long
　　Dim m As Long
　　Dim p As Long
　　Dim flg As Boolean
　　i = 1
　　j = 1
　　p = 2
　　Do
　　　　flg = False
　　　　For m = 2 To Int(Sqr(p))
　　　　　　If p Mod m = 0 Then
　　　　　　　　flg = True
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　　　If flg = False Then
　　　　　　Cells(i, j) = p
　　　　　　i = i + 1
　　　　　　If i > Rows.Count Then
　　　　　　　　i = 1
　　　　　　　　j = j + 1
　　　　　　End If
　　　　End If
　　　　p = p + 1
　　Loop
End Sub
======================

回答No.4

f272

#1 & #3です。
> 次に　np=１００００００＋００をやったら
> デバッグとか言って黄色い行ラインが出てくるがこれを正しく
> 修正すると、走るのではないか？

これは，そんなに大きなnpを使うとは思わなかったので，1列に書けるだけしか領域を確保していないためです。コードの最後の方にある
Range("A1").Resize(j) = pp
を
If j > Rows.Count Then
j1 = Int(j / Rows.Count)
j2 = j Mod Rows.Count
ReDim pp1(Rows.Count, j1) As Long
For k = 0 To j1 - 1
For j = 0 To Rows.Count - 1
pp1(j, k) = pp(j + k * Rows.Count, 0)
Next j
Next k
Range("A1").Resize(Rows.Count, j1) = pp1
ReDim pp2(j2, 0) As Long
For j = 0 To j2 - 1
pp2(j, 0) = pp(j + j1 * Rows.Count, 0)
Next j
Range("A1").Offset(, j1).Resize(j2) = pp2
Else
Range("A1").Resize(j) = pp
End If
に変えると動きます。私のいつも使うPCだと35秒くらいで5,761,455番目の素数である99,999,989を出力します。

> 何故まったく同じ結果となったかわからない。

アルゴリズムは違っても同じ結果を返すマクロなのだから当然ですよ。

回答No.3

f272

#1です。
ついでに言っておくと，アルゴリズムは正しいのだけれど効率は非常に悪い。
セルにアクセスする回数は極力減らすことが速度向上のためには大事なことです。また，pを2から1づつ増やすのは効率が悪い。奇数は素数でないことは明らかなのだからコードの中で明示的に省いておくべきです。そうすると
Sub 素数を求める3()
Dim np As Long
np = 1000000 'これが調べる最大の数
Dim i As Long
Dim m As Long
Dim p As Long
Dim flg As Boolean
Dim s As Variant
ReDim pp(np, 1) As Long
s = Timer
pp(0, 0) = 2
i = 1
p = 3
Do
flg = False
For m = 3 To Int(Sqr(p)) Step 2
If p Mod m = 0 Then
flg = True
Exit For
End If
Next
If flg = False Then
pp(i, 0) = p
i = i + 1
End If
p = p + 2
Loop Until p > np
Range("A1").Resize(i) = pp
MsgBox "Elapse time=" & Timer - s
End Sub
こんな感じになる。でももっといいのはエラトステネスの篩を使って判断することでしょう。そうすると
Sub 素数を求める4()
Dim np As Long
np = 10000000 'これが調べる最大の数
Dim i As Long
Dim j As Long
Dim k As Long
ReDim p(np) As Boolean
ReDim pp(np, 1) As Long
Dim s As Variant
s = Timer
For i = 0 To np - 1
p(i) = True
Next i
p(0) = False
For i = 2 To Int(Sqr(np)) + 1
k = Int(np / i)
For j = 2 To k
If (p(i * j - 1)) Then
p(i * j - 1) = False
End If
Next j
Next i
j = 0
For i = 0 To np - 1
If (p(i)) Then
pp(j, 0) = i + 1
j = j + 1
End If
Next i
Range("A1").Resize(j) = pp
MsgBox "Elapse time=" & Timer - s
End Sub
こんな感じになる。

お礼

上のマクロで
np=1000000+0 で６６４５７９番目（９９９９９９１）をたたき出した。
下のエラトステネス篩では
np＝１０００００００で６６４５７９番目（９９９９９９１）をたたき出した。
何故まったく同じ結果となったかわからない。
np=npだから？しかしエラトステネスの篩は早いんじゃないのかな。
結果は同じでもタイムはエラトステネスが早かったのか？
も少し、調べてみます。
貴方のアイコンは”数学”カテゴリーでもよく見ます。昔から。
とにかく、マクロを教えてくれてありがとう。感謝です。

補足

上の方のマクロ
np=１００００００
ｔ＝０．７９６８７５って1秒もたってないのか？
78498番目（９９９９８３）
をたたき出す。
この辺のマクロでタイマーは必須。
次に　np=１００００００＋００をやったら
デバッグとか言って黄色い行ラインが出てくるがこれを正しく
修正すると、走るのではないか？
下のマクロはまだやってない。
エラトステネスの篩はその分早くなるはずだが。

回答No.2

HohoPapa

暴走しているのではなく
画面のリフレッシュが追いつかない可能性を疑います。
適当なサイクルで
　DoEvents
を実行すれば、結果なり、変数が
オーバーフローするまで実行し続けると思います。

Sub 素数を求める()
　　Dim i As Long
　　Dim j As Long

　　途中略

　　　　p = p + 1

　　　　If i Mod 1000 = 0 Then
　　　　　DoEvents
　　　　End If

　　Loop
End Sub

回答No.1

f272

doループから脱出する条件がないので，無限に計算をし続けて暴走します。
最低でも
Loop
を例えば
Loop Until p > 10000
のように確実に止まるようにしましょう。

お礼

こんにちは。
===========================
Loop Until p > 10000について
===========================
Loop Until p > 100000000を設定したら不可となった。
暴走状態になった。
当然だが原因があるので、それらを解決させると可能となるかもしれない。
しかたないので
Loop Until p > 10005000を設定したら
６６４８８４番目（１０００４９８３）をたたき出した。
次に
Loop Until p > 10055000を設定したら
６６８０２９番目（１００５４９９７）をたたき出した。
しかし、これ以上はやっていない。
偶数も計算させている割には意外と速度は速い。
面白い。面白い。

補足

こんにちは。
１００００を設定しましたら、1229番目：９９７３まで行きました。
10万とか１００万とか1億とか、どこまで可能なのか？
いずれ、フリーズする場面がまた、出てくるものと予想されます。
やってみます。面白いですね。