Option Explicit
Sub Prim()
Dim Zahl As Double, Zei As Long, T As Single
T = Timer
Range("A:B").NumberFormat = "@"
Application.ScreenUpdating = False
For Zahl = 9000000000000# To 9000000005000#
Application.StatusBar = CStr(Zahl) & " / " & "9000000005000"
Zei = Zei + 1
Cells(Zei, 1).Value = CStr(Zahl)
Cells(Zei, 2).Value = primfaktoren(Zahl)
Next Zahl
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox Format(Timer - T, "0.0") & " sek"
End Sub
Function primfaktoren(Zahl) As String
' Autor: Ransi
' Quelle: http://www.office- _
loesung.de/ftopic226249_0_0_asc.php
Dim dummy As String
Dim test
Dim wurzel
Dim pruefen
test = Zahl
wurzel = Sqr(Zahl)
If Zahl http://www.office- _
loesung.de/ftopic226249_0_0_asc.php
Dim wurzel
Dim L
Dim bol As Boolean
bol = True
'Eine Schleife aufsetzen bis zur Wurzel der Zahl.
'Ist die Zahl durch ein Element der Schleife teilbar dann ist
'die Zahl keine Primzahl.
wurzel = Int(Sqr(Zahl))
For L = 2 To wurzel
If (Zahl / L) = Int(Zahl / L) Then
bol = False
Exit For
End If
Next
primzahltest = bol
End Function
Sub primzerleg()
reihe = 9
prim = ""
Application.ScreenUpdating = False
'For i = 9000000000000# To 9000000005000#
For i = 1 To 50
zahl = i
Do
teil = 2
z = zahl / teil
Do While z Int(z)
teil = teil + 1
z = zahl / teil
If teil > 5 Then ausgabe = i: GoTo ende
Loop
'Teiler korrekt
prim = prim & "*" & teil
zahl = z
Loop While zahl > 2
ausgabe = Mid(prim, 2, 99)
ende:
Cells(reihe, 1) = i
Cells(reihe, 2) = ausgabe
Cells(reihe, 3).Formula = IIf(ausgabe i, "=" & Mid(prim, 2, 99), "")
prim = ""
reihe = reihe + 1
Next i
End Sub