Gruppe
Allgemein
Problem
In die Tabelle werden die Primzahlen zwischen 1 und 10.000.000 eingetragen. Die Routine kann mit ESCAPE abgebrochen werden.
StandardModule: Modul1
Option Base 1
Sub PrimeNumbers()
Dim VNum As Long
Dim VMaxNum As Long
Dim i As Long
Dim VMaxInd As Long, VMinNum As Long, lRow As Long
Dim Prime() As Variant
Dim VCtrl As Boolean
Application.EnableCancelKey = xlErrorHandler
On Error GoTo ERRORHANDLER
Cells.ClearContents
Application.ScreenUpdating = False
VMaxInd = 1
ReDim Prime(VMaxInd)
Prime(1) = 2
VMinNum = 1
VMaxNum = 10000000
For VNum = 3 To VMaxNum Step 2
VCtrl = True
For i = 1 To VMaxInd
If VNum Mod Prime(i) = 0 Then
VCtrl = False
Exit For
ElseIf (Prime(i)) ^ 2 > VNum Then ' <--- this is the trick!
Exit For
End If
Next i
If VCtrl = True Then
VMaxInd = VMaxInd + 1
ReDim Preserve Prime(VMaxInd)
Prime(VMaxInd) = VNum
lRow = lRow + 1
Cells(lRow) = VNum
If lRow Mod 1000 = 0 Then Application.StatusBar = "Trage die " & lRow & ". Primzahl ein (abbrechen mit ESC)..."
End If
Next VNum
ERRORHANDLER:
Application.StatusBar = False
End Sub