Datenfeld zur Primzahlenbestimmung VBA

Computer: Software & Programmierung Visual Basic
#1

Guten Tag,
ich versuche seit 3 Tagen meine denkfehler zu finden. Möchte ein Programm in VBA mit excel 2003 schreiben, das mit hilfe des siebs von eratosthenes primzahlen bestimmen kann,wichtig: mit array.
dass mein programm prüft ob es sich um Primzahlen handelt, hab ich mit hilfe einer funktion gemacht. das tut auch, aber ich komm einfach nicht drauf was ich schreiben soll,damit auch die vielfachen einer primzahl mit „Keine Primzahl“ in ihrem jeweiligen feld gespeichert werden.

mein code:
Private Function AnzahlTeiler(i As Variant) As Long
Dim Testzahl As Long
AnzahlTeiler = 0
For Testzahl = 1 To i
If i Mod Testzahl = 0 Then
AnzahlTeiler = AnzahlTeiler + 1
End If
Next

End Function

Private Sub CommandButton1_Click()

Dim Zahlenmenge() As Variant
Dim Zahlen As Long
Zahlen = InputBox(„Bis zu welcher Zahl?“)
Dim i As Variant

Dim Vielfaches As Long
Dim Hochzahl As Long
Dim Zahl As Long

ReDim Zahlenmenge(Zahlen)

For i = 2 To Zahlen
Zahlenmenge(i) = „Primzahl“
If AnzahlTeiler(i) = 2 Then
Tabelle1.Cells(i, 1).Value = i

Else
Tabelle1.Cells(i, 3).Value = i
Zahlenmenge(i) = „Nicht Primzahl“
End If
Next i

kann mir jemand helfen?wär soo froh
lieben gruß

#2

Grüeui faehnle

ich versuche seit 3 Tagen meine denkfehler zu finden. Möchte
ein Programm in VBA mit excel 2003 schreiben, das mit hilfe
des siebs von eratosthenes primzahlen bestimmen kann,wichtig:
mit array.

Ach, das schöne ‚alte‘ Sieb des Erathostenes :smile:

dass mein programm prüft ob es sich um Primzahlen handelt, hab
ich mit hilfe einer funktion gemacht. das tut auch, aber ich
komm einfach nicht drauf was ich schreiben soll,damit auch die
vielfachen einer primzahl mit „Keine Primzahl“ in ihrem
jeweiligen feld gespeichert werden.

Ich kann dir hier mal meinen Code geben, der ein wenig anders aufgebaut ist - es werden die ersten 60’000 Primzahlen ermittelt und in A2:A60001 geschrieben. Die Basis ist das Sieb des Erathostenes, das in der inneren Schleife gefüllt wird.
Der Code ist auf Tempo getrimmt, auf meinem Rechner dauert das Erzeugen des Arrays mit Übertagen ins Tabellenblatt knapp 0.4 Sekunden. (den Timer habe ich mal drin gelassen).

Vielleicht kannst Du ja etwas daraus entnehmen.

Option Explicit
Option Base 1

Dim t

Public Sub Thom()
 t = Timer
 Const pMax As Long = 1000000
 Dim p(pMax) As Boolean
 Dim x(60000, 1) As Long
 Dim lngX As Long
 Dim lngP As Long
 Dim lngI As Long

 lngP = 1
 lngX = 0
 Do
 lngX = lngX + 1
 Do
 lngP = lngP + 1
 Loop Until Not p(lngP)
 For lngI = lngP To UBound(p()) Step lngP
 p(lngI) = True
 Next lngI
 x(lngX, 1) = lngP
 Loop Until lngX = 60000
 Range("A2:A60001") = x
 Range("A1") = "Thom" & vbCrLf & Timer - t
End Sub

Mit freundlichen Grüssen

Thomas Ramel

  • MVP für MS-Excel -
#3

Hallo und danke schonmal:smile:
nur ehrlich gesagt versteh ich deinen code auch nich mehr, weil mir da noch viel mehr unbekannte sachen drin stehn…
mein Problem ist glaube ich einfach, dass ich ab dem Test ob es sich um eine Primzahl handelt,nicht mehr weiterkomme…
Ist mein Code sonst so schon ok?
danke:smile:

#4

Grüezi raehnle

nur ehrlich gesagt versteh ich deinen code auch nich mehr,
weil mir da noch viel mehr unbekannte sachen drin stehn…

Ja, das kann durchaus sein, er ist ja auc nicht in fünf Minuten entstanden :wink:

mein Problem ist glaube ich einfach, dass ich ab dem Test ob
es sich um eine Primzahl handelt,nicht mehr weiterkomme…
Ist mein Code sonst so schon ok?

Soweit passt das doch ganz gut, denke ich.

Ergänze vielleicht noch folgendes:

ReDim Zahlenmenge(1 To Zahlen)

und füge ganz am Ende die folgende Zeile ein, dann wird dir dein Array auch gleich mit ausgegeben:

Range(„E1:E100“).Value = WorksheetFunction.Transpose(Zahlenmenge())

Mit freundlichen Grüssen

Thomas Ramel

  • MVP für MS-Excel -
#5

OT Sieb des Erathostenes
Grüezi Thomas,

nur Betreffänderung für’s Archiv.

Gruß
Reinhard

Ach, das schöne ‚alte‘ Sieb des Erathostenes :smile:

Option Explicit
Option Base 1

Dim t

Public Sub Thom()
t = Timer
Const pMax As Long = 1000000
Dim p(pMax) As Boolean
Dim x(60000, 1) As Long
Dim lngX As Long
Dim lngP As Long
Dim lngI As Long

lngP = 1
lngX = 0
Do
lngX = lngX + 1
Do
lngP = lngP + 1
Loop Until Not p(lngP)
For lngI = lngP To UBound(p()) Step lngP
p(lngI) = True
Next lngI
x(lngX, 1) = lngP
Loop Until lngX = 60000
Range(„A2:A60001“) = x
Range(„A1“) = „Thom“ & vbCrLf & Timer - t
End Sub

Mit freundlichen Grüssen

Thomas Ramel

  • MVP für MS-Excel -