AW: Primzahlen errechnen
05.07.2003 12:15:57
Sigi E.
Hallo Aline,
probier' mal dies ...
Sub Primzahlen_ermitteln()
Dim Zahl As Long
Dim Divisor As Long
Dim Quotient As Double
Dim Text As String
Dim Titel As String
Dim Eingabe As String
Dim Teiler As Boolean
Dim Ogrenze As Long
Dim Ugrenze As Long
Dim i As Long
Dim j As Long
Titel = "Primzahlen ermitteln"
Text = "Bitte Zahl als 'Untergrenze' eingeben!"
Beep
Eingabe = InputBox(Text, Titel, "1")
If Eingabe = "" Or Not IsNumeric(Eingabe) Then
GoTo Fehler
Else
Ugrenze = CLng(Eingabe)
End If
Text = "Bitte Zahl als 'Obergrenze' eingeben!"
Beep
Eingabe = InputBox(Text, Titel, "1000")
If Eingabe = "" Or Not IsNumeric(Eingabe) Then
GoTo Fehler
Else
Ogrenze = Eingabe
End If
i = 2
j = 2
Range("B2:B65536").ClearContents
For Zahl = Ugrenze To Ogrenze
Teiler = False
Divisor = 2
Do Until Divisor ^ 2 > Zahl Or Teiler = True
Quotient = Zahl / Divisor
If Quotient = Int(Quotient) Then
Teiler = True
End If
Divisor = Divisor + 1
Loop
If Teiler = True Then
'keine Primzahl
Else
'Primzahl
Cells(i, 2).Value = Zahl
i = i + 1
If i Mod 500 = 0 Then
Application.StatusBar = "*** Bearbeite Zelle ''B" & i & "'' ***"
End If
j = j + 1
If j > 65533 Then
MsgBox "Spalte B ist voll!", vbCritical, "Abbruch"
Exit Sub
End If
End If
Next Zahl
Application.StatusBar = ""
Exit Sub
Fehler:
MsgBox "Sie haben keine Zahl eingegeben !" & Chr(13) & _
"Programm wird abgebrochen !", vbCritical, Titel
End Sub
Gruß
Sigi