Dreieckszahlen
geschrieben von Nina | in der Kategorie "Allgemeines" Mittwoch 10. Feb 2010 um 23:26 UhrIch habe mir gerade eine VBA-Prozedur für geschrieben, die mir Primzahlen ausgibt. Hier zunächst der Code zum nachmachen:
Sub Primzahlen()
Dim i As Long, j As Long, Primzahl As Boolean
Dim zeile As Integer
Dim ende As Integer
ende = 32000
zeile = 1Application.ScreenUpdating = False
For i = 1 To ende: Primzahl = True
For j = 2 To ende
If i Mod j = 0 And i <> j Then Primzahl = False
Next j
If Primzahl = True Then
Cells(zeile, 1) = i
zeile = zeile + 1
End If
Next iApplication.ScreenUpdating = True
End Sub
Bei diesem Code streicht Excel bei ende=32000 die Segel in Form eines Laufzeitfehlers “Überlauf”. 33000 darf ich schon gar nicht prüfen lassen. Also habe ich gegrübelt, wie viele Rechenschritte das sind. Die Suchmaschine stupste mich daraufhin auf die Dreieckszahlen, und mit der Formel dazu konnte ich die Anzahl der Rechenschritte ausrechnen lassen. Bei Primzahlen bis 10 sind es 55 Schritte, die das Programm durchprobieren muss. Bis 100 sind es schon 5050, bei 1000 500500, bei 10000 50005000 und bei den 32000 dann 512016000 Rechenschritte.
Interessant fand ich auch: Wenn ich die Anzahl der Schritte noch als inkrementierte Variable mit in den Code nehme, erfolg der Laufzeitfehler schon bei ende=2000. Excel ist schon komisch…
Und noch eine Auffälligkeit: Die Primzahlen bis zur 36 (=6*6) werden in 666 Schritten getestet.
Wem fällt noch mehr auf?
PS:
Oh, mir fällt was auf: Wenn man die falschen Datentypen deklariert, dann MUSS ja ein Laufzeitfehler kommen. Integer geht halt nicht bis 33000 *kopftisch*
Also auf ein Neues…
Hallo Nina.
Das mit den Dreieckszahlen stimmt aber nur dann, wenn die j-Schleife von 1 bis i läuft. Sie fängt aber bei 2 an und bräuchte übrigens nur bis zur Wurzel aus i laufen (und könnte sogar vorher mit “Exit For” verlassen werden, sobald feststeht, dass i keine Primzahl ist). 666 ist übrigens die Summe der Zahlen beim Roulette…
Ich schicke später mein liebstes Primzahlverfahren hinterher.
Viele Grüße,
Wolfgang
Hallöchen nochmal.
Hier ein Modul mit mehreren Private-Prozeduren/-Funktionen und einer Public-Prozedur, mit der die Excel-Tabelle relativ schnell gefüllt werden kann. Die Obergrenze kann mit der Konstanten MaxZahl gesteuert werden.
Viel Spaß damit und viele Grüße,
Wolfgang
Option Explicit
Private Const MaxZahl As Long = 32000
Private Const MaxIndex As Long = (MaxZahl – 1) \ 32
Private PrimzahlBitmap(MaxIndex) As Long
Private Bitmaske(31) As Long
Private Sub Initialisieren()
Dim i As Long
‘ In Bitmaske(i) wirt genau Bit i gesetzt
Bitmaske(0) = 1
For i = 1 To 30
Bitmaske(i) = 2 * Bitmaske(i – 1)
Next i
Bitmaske(31) = &H80000000
‘ Zunächst sind alle Zahlen Primzahlen…
For i = 0 To MaxIndex
PrimzahlBitmap(i) = &HFFFFFFFF
Next
‘ … außer die 1.
PrimzahlBitmap(0) = PrimzahlBitmap(0) And Not 1
End Sub
Private Function IstPrimzahl(Zahl As Long) As Boolean
Dim BitNr As Long, ZahlNr As Long
‘ Ein Bit aus der PrimzahlBitmap auslesen
BitNr = (Zahl – 1) Mod 32
ZahlNr = (Zahl – 1) \ 32 ‘ Ganzzahlige Division
If (PrimzahlBitmap(ZahlNr) And Bitmaske(BitNr)) 0 Then _
IstPrimzahl = True
End Function
Private Sub KeinePrimzahl(Zahl As Long)
Dim BitNr As Long, ZahlNr As Long
BitNr = (Zahl – 1) Mod 32
ZahlNr = (Zahl – 1) \ 32 ‘ Ganzzahlige Division
‘ Primzahl-Bit der Zahl löschen
PrimzahlBitmap(ZahlNr) = _
PrimzahlBitmap(ZahlNr) And Not Bitmaske(BitNr)
End Sub
Private Sub Siebverfahren() ‘ (…des Eratosthenes)
Dim Primzahl As Long, Quadrat As Long, Vielfaches As Long
Primzahl = 2: Quadrat = Primzahl * Primzahl
Do
For Vielfaches = Quadrat To MaxZahl Step Primzahl
Call KeinePrimzahl(Vielfaches)
Next Vielfaches
Do ‘ nächste Primzahl aus der Bitmap suchen
Primzahl = Primzahl + 1
Loop Until IstPrimzahl(Primzahl)
Quadrat = Primzahl * Primzahl
Loop Until Quadrat > MaxZahl
End Sub
Public Sub Primzahlen()
On Error GoTo Err_Primzahlen
Dim Zahl As Long, Zähler As Long
Initialisieren
Siebverfahren
Application.ScreenUpdating = False
For Zahl = 1 To MaxZahl
If IstPrimzahl(Zahl) Then
Zähler = Zähler + 1
Cells(RowIndex:=Zähler, Columnindex:=1) = Zahl
End If
Next Zahl
Application.ScreenUpdating = True
MsgBox Zähler & ” Primzahlen bis ” & MaxZahl & ” gefunden.”, vbInformation
Exit_Primzahlen:
Exit Sub
Err_Primzahlen:
Application.ScreenUpdating = True
MsgBox Err.Description, vbExclamation, “Fehler aufgetreten:”
Resume Exit_Primzahlen
End Sub