Thema: Primzahlen 1 bis 10.000.000 eintragen

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

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Berechnen