Sub Primfaktoren(inData As Long, outData() As Long)

    '################################################################

    '# Erwartet einen Long-Wert in inData und gibt ein Long-Array   #

    '# outData() zurück, das die in Faktoren zerlegte Zahl enthält. #

    '# die zurückgegebenen Faktoren sind aufsteigend sortiert.      #

    '################################################################

    Dim Res As Long

    Dim Div As Long ' Divisor

    '

    ' Zunächst einmal nehmen wir an, daß inData eine Primzahl ist, also

    ' keine weiteren ganzzahligen Faktoren enthält.

    '

    ' Größe des Arrays: 0 To 0

    '

    ReDim outData(0)

    '

    ' Das "letzte Element", daß hier gleich dem ersten ist, erhält inData.

    '

    outData(0) = inData

    If outData(0) < 4 Then ' 1, 2 und 3 sind Primzahlen

        Exit Sub

    End If

    '

    ' Alle vielfachen Teiler von 2 abtrennen

    '

    Res = outData(0) Mod 2

    Do While Res = 0 And outData(UBound(outData)) >= 4

        ' Array um ein Element vergrößern

        ReDim Preserve outData(UBound(outData) + 1)

        ' Das letzte Feld erhält den noch zu unterschenden Rest

        outData(UBound(outData)) = outData(UBound(outData) - 1) / 2

        ' Das vorletzte erhält den Faktor 2

        outData(UBound(outData) - 1) = 2

        Res = outData(UBound(outData)) Mod 2

    Loop

    '

    ' Da wir alle vielfachen von 2 soeben entfernt haben wissen wir nun,

    ' daß die verbleibende Zahl ungerade, also nicht mehr durch 2 teilbar ist.

    ' Wir untersuchen nur noch ungerade Teiler (3, 5, 7 ...), laufen also in

    ' Zweierschritten und damit doppelt so schnell.

    '

    ' Wenn wir uns von unten nähern, sind wir fertig, sobald das Quadrat des aktuellen

    ' Teilers größer ist als die verbleibende Zahl.

    '

    ' Startwert für Divisor: 3

    '

    Div = 3

    Do While outData(UBound(outData)) >= Div * Div

        Res = outData(UBound(outData)) Mod Div

        Do While Res = 0 And outData(UBound(outData)) >= Div * Div

            ' Array um ein Element vergrößern

            ReDim Preserve outData(UBound(outData) + 1)

            ' Das letzte Feld erhält den noch zu unterschenden Rest

            outData(UBound(outData)) = outData(UBound(outData) - 1) / Div

            ' Das vorletzte erhält den aktuellen Divisor

            outData(UBound(outData) - 1) = Div

            Res = outData(UBound(outData)) Mod Div

        Loop

        Div = Div + 2

    Loop

End Sub

Public Sub TestePrimzahl()

    Dim TestZahl As Long

    Dim Ergebnis() As Long

    Dim i As Integer



    TestZahl = 97454921 ' (ist Primzahl)

'    TestZahl = 97454929 ' =  11 * 13 * 37 * 113 * 163



    Call Primfaktoren(TestZahl, Ergebnis)

    If LBound(Ergebnis) = UBound(Ergebnis) Then

        ' Das zurückgegebene Feld enthält nur ein Element

        Debug.Print "Primzahl: "; Ergebnis(LBound(Ergebnis))

    Else

        ' Primfaktoren ausgeben

        Debug.Print TestZahl; " = "; Ergebnis(LBound(Ergebnis));

        For i = LBound(Ergebnis) + 1 To UBound(Ergebnis)

            Debug.Print "*"; Ergebnis(i);

        Next

        Debug.Print

    End If

End Sub