' geändert von W.Radner Jan.2001
'
' unterschiedliche Laufzeiten der Originalversion und der
' geänderten Version werden besonders deutlich, wenn man
' sich alle Primzahlen von 20000 bis 30000 ausgeben läßt
'
' EXCEL-Primzahlenprogramm
' copyright by Thomas Igel
' EXCEL-Homepage: http://ourworld.compuserve.com/homepages/thomas_igel
' email: thomas_igel@compuserve.com

Dim testzahl As Double

Sub primzahl()
    Dim teiler(1 To 1000)
    Eingabewert = InputBox("Geben Sie hier den Zahlenwert ein:", "Zahl auf Primzahl überprüfen")
    If Eingabewert = "" Then Exit Sub
    testzahl = Eingabewert
    'Vorschlag für Prim_FAKTOR_zerlegung
    Faktorzahl = testzahl
    j = 0
    Do While Faktorzahl Mod 2 = 0
       j = j + 1
       Faktorzahl = Faktorzahl \ 2
       teiler(j) = 2
    Loop
    i = 3
    Do While i <= Faktorzahl
    If Faktorzahl Mod i = 0 Then
        j = j + 1
        Faktorzahl = Faktorzahl \ i
        teiler(j) = i
    Else
        i = i + 2
    End If
    Loop
    Select Case j
    Case Is > 1:
        meldtext = ""
        komma = ", "
        For k = 1 To j
            If k = j Then komma = "."
            meldtext = meldtext & teiler(k) & komma
        Next k
        meld = MsgBox("Die Zahl " & testzahl & " ist keine Primzahl, Primfaktorzerlegung=" & Chr(10) & " " & Chr(10) & meldtext)
    Case Else:
        meld = MsgBox(testzahl & " ist eine Primzahl", , "Primzahl")
    End Select
End Sub

Sub Eingabe_bereich()
    DialogSheets("Dialog1").DrawingObjects("von").Text = ""
    DialogSheets("Dialog1").DrawingObjects("bis").Text = ""
    ActiveWorkbook.DialogSheets("Dialog1").Show
End Sub
    
    
Sub list_Primzahl()
    Dim primzahl(1 To 10000)
    i = 1
    With ActiveDialog
        von = DialogSheets("Dialog1").[von].Text
        bis = DialogSheets("Dialog1").[bis].Text
    End With
    If von = "" Or bis = "" Then
        Beep
        meld = MsgBox("Die Felder 'von' und 'bis' müssen einen Zahlenwert erhalten!", , "Eingabefehler")
        Exit Sub
    End If
    'Sonderfälle (Code nicht optimal, aber dafür einfach)
    If von = 1 Then
       primzahl(i) = 1
       i = i + 1
    End If
    If von <= 2 Then
       primzahl(i) = 2
       i = i + 1
       If bis < 3 Then
         GoTo c
       Else
         von = 3
       End If
    End If
    'Anpassung um für große Zahlen Step 2 zu ermöglichen
    If von Mod 2 = 0 Then von = von + 1
    If bis Mod 2 = 0 Then bis = bis - 1
    For j = von To bis Step 2
        flag = 0
        'nur bis zur Wurzel testen!
        For k = 3 To Sqr(j) Step 2
            If j Mod k = 0 Then
                flag = 1
                GoTo b
            End If
            flag = 0
        Next k
        If flag = 0 Then
            primzahl(i) = j
            i = i + 1
        End If
b:
    Next j
c:
    Sheets("Tabelle1").Select
    Columns("B:X").Select
    Selection.ClearContents
    'geändert, da ich "von" und "bis" programmintern evtl. abändere!
    Range("B10") = "Primzahlen von " & DialogSheets("Dialog1").[von].Text & " bis " & DialogSheets("Dialog1").[bis].Text & " :"
    Range("B11").Select
    m = 1
    For l = 1 To i
        If m = 15 Then
            ActiveCell.Offset(-14, 1).Range("A1").Select
            m = 1
        End If
        ActiveCell.Value = primzahl(l)
        ActiveCell.Offset(1, 0).Range("A1").Select
        m = m + 1
    Next l
    Range("A1").Select
End Sub