'kopiert aus Thread "Primzahlberechnung" vom 8. Dezember. in de.sci.mathematik
'
'Um's zusammenzufassen: Alle Primzahlen > 3 sind von der Form  6*k+1 oder
'6*k-1 (den Beweis findest du im o. Thread).
'
'Jede ganze Zahl >= 0 läßt sich schreiben in der Form
'
'6k,  oder 6k+1, 6k+2, 6k+3, 6k+4, 6k+5,  wobei k eine ganze Zahl >= 0 ist.
'
'Man fängt mit k = 0 an und bekommt 0 und die ersten 5 natürlichen Zahlen, dann
'nimmt man k=1 und bekommt die nächsten 6 und so weiter. Wenn man sich die Zahlen
'mal anschaut, sieht man, dass 6k, 6k+2 und 6k+4 imer durch 2 teilbar sind, 6k+3
'immer durch 3. Mit der Ausnahme der Primzahlen 2 und 3 selber (die sind von der
'Form 6k+2 bzw. 6k+3, k=0) müssen also alle anderen Primzahlen von der Form 6k+1
'bzw. 6k + 5 sein. Letzteres läßt sich aber schreiben als 6m -1 mit m = k+1. Und
'da die Wahl der Buchstaben nichts bedeutet haben wir:
'
'Jede Primzahl, mit der Ausnahme von 2 und 3, ist von der Form 6k+1 bzw. 6k -1 für
'ein geeignetes ganzzahliges k>=0
'
'so weit bin ich in meiner Funktion (s.u.) noch nicht gegangen, wer will
'kann das ja noch selbst optimieren

'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@onlinehome.de
'Benutzung frei - ohne Gewähr


Public Function prim(Optional sw As Long, Optional exi As Integer) As Long

If exi = CInt(0) Then exi = CInt(4)
If sw = CLng(0) Then sw = CLng(Rnd * 10 ^ exi)

Do
  gefunden = True
  prim = 0
  Select Case sw
    Case 1, 2, 3: prim = sw
    Case Is > 3:
            If sw Mod 2 = 1 Then
               i = 3
               wsw = CLng(Sqr(sw) + 1)
               Do
                 If sw Mod i = 0 Then
                    sw = sw + 2
                    gefunden = False
                 Else
                    i = i + 2
                 End If
               Loop Until Not gefunden Or i > wsw
               If gefunden Then prim = sw
            Else
               sw = sw + 1
               gefunden = False
            End If
  End Select
Loop Until gefunden
End Function
'mit=prim(Bezug+1) und kopierter Formel
'kannman eine ganze Primzahlenreihe erzeugen!
'z.B. A1=0 A2=prim(a1) A3=prim(a2+1) ...
'mit prim(0;3) erzeugt man eine "zufällige"
'Primzahl zw. 1 und 1001... um randomize
'mußman sich selbst kümmern

Sub primfakt()
On Error GoTo abbr
sw = Fix(ActiveCell.Value)
ofs = 0

Select Case sw
   Case 0, 1, 2: ActiveCell.Offset(1, 0) = Fix(sw)
                 ofs = 1
   Case Is > 2: Do
                  swr = sw Mod 2
                  If swr = 0 Then
                     sw = sw \ 2
                     ofs = ofs + 1
                     ActiveCell.Offset(ofs, 0) = 2
                   End If
                Loop Until swr <> 0
                wsw = Fix(Sqr(sw) + 1)
                i = 3
                Do
                  swr = sw Mod i
                  If swr = 0 Then
                     sw = sw \ i
                     ofs = ofs + 1
                     ActiveCell.Offset(ofs, 0) = i
                  Else
                     i = i + 2
                  End If
                Loop Until i >= wsw
                If sw > 1 Then
                   ofs = ofs + 1
                   ActiveCell.Offset(ofs, 0) = sw
                End If
   Case Else:
End Select

ActiveCell.Offset(ofs + 1, 0) = ">>>"

Range(ActiveCell.Address, ActiveCell.Offset(ofs + 1, 0).Address).Select
Exit Sub
abbr:
ActiveCell.Offset(1, 0) = "err"
End Sub

Public Function prim_d(Optional sw As Double, Optional exi As Integer) As Double

If exi = CInt(0) Then exi = CInt(4)
If sw = CDbl(0) Then sw = CDbl(Fix(Rnd * 10 ^ exi))

Do
  gefunden = True
  prim_d = 0
  Select Case sw
    Case 1, 2, 3: prim_d = sw
    Case Is > 3:
            'If sw Mod 2 = 1 Then
            If (sw / 2) - Fix(sw / 2) > 0 Then
               i = 3
               wsw = CDbl(Fix(Sqr(sw) + 1))
               Do
                 'If sw Mod i = 0 Then
                 If (sw / i) - Fix(sw / i) = 0 Then
                    sw = sw + 2
                    gefunden = False
                 Else
                    i = i + 2
                 End If
               Loop Until Not gefunden Or i > wsw
               If gefunden Then prim_d = sw
            Else
               sw = sw + 1
               gefunden = False
            End If
  End Select
Loop Until gefunden
End Function
'mit=prim_d(Bezug+1) und kopierter Formel
'kannman eine ganze Primzahlenreihe erzeugen!
'z.B. A1=0 A2=prim_d(a1) A3=prim_d(a2+1) ...
'mit prim_d(0;3) erzeugt man eine "zufällige"
'Primzahl zw. 1 und 1001... um randomize
'mußman sich selbst kümmern

Sub primfakt_d()
On Error GoTo abbr
sw = CDbl(Fix(ActiveCell.Value))
ofs = 0

Select Case sw
   Case 0, 1, 2: ActiveCell.Offset(1, 0) = Fix(sw)
                 ofs = 1
   Case Is > 2: Do
                  'swr = sw Mod 2
                  swr = (sw / 2) - Fix(sw / 2)
                  If swr = 0 Then
                     'sw = sw \ 2
                     sw = Fix(sw / 2)
                     ofs = ofs + 1
                     ActiveCell.Offset(ofs, 0) = 2
                   End If
                Loop Until swr <> 0
                wsw = Fix(Sqr(sw) + 1)
                i = 3
                Do
                  'swr = sw Mod i
                  swr = (sw / i) - Fix(sw / i)
                  If swr = 0 Then
                     'sw = sw \ i
                     sw = Fix(sw / i)
                     ofs = ofs + 1
                     ActiveCell.Offset(ofs, 0) = i
                  Else
                     i = i + 2
                  End If
                Loop Until i >= wsw
                If sw > 1 Then
                   ofs = ofs + 1
                   ActiveCell.Offset(ofs, 0) = sw
                End If
   Case Else:
End Select

ActiveCell.Offset(ofs + 1, 0) = ">>>"

Range(ActiveCell.Address, ActiveCell.Offset(ofs + 1, 0).Address).Select
Exit Sub
abbr:
ActiveCell.Offset(1, 0) = "err"
End Sub


'einfach Programmerweiterung
Sub primfakt_d_each()
Dim Zelle As Range
For Each Zelle In Selection
  Zelle.Activate
  primfakt_d
Next
'unter jeder Zelle sollte Platz für die Primfaktoren
'freigehalten werden (ca. 10 Zeilen?)