|
zur vollstaendigkeit! :) 99% in der ausarbeitung...
Option Explicit
'Programm zur Auflistung von Zahlen bis einer einzugebenen Obergrenze und Listung in einzugebener Spaltenanzahl
'Erstellt und getestet durch Thomas Kpunkt, Fachschueler der Fachschule der Technik am BKGuT in Aachen
'Zur Hilfe der Abfrage der Primzahlen wurde http://www.activevb.de/tutorials/tut_primzahlen/primzahlen.html zur Hilfe genommen
'In diesem Programm wird die Zahl "1" als Primzahl zwar berechnet, aber durch die Programmzeile, welche mit * im Kommentar markiert sind, wieder ausgelistet
'Um Fehleingaben und Überläufe zu vermeiden sind Eingaben <= 0, > 30000 bzw > 1000, Buchstaben und leere Inputboxen ausgeschlossen, hier werden Ersatzwerte geliefert
'Weil die Formatierung der Ausgabezellen Performance kostet, wurde noch ein Timer eingebaut, Hilfestellung: http://www.mrexcel.com/archive/VBA/20164.html
Sub prtest() 'Start Makro
Dim obergr As Variant 'Definieren der Variablen
Dim spaltenanz As Variant '"
Dim spalte As Integer '"
Dim zeile As Integer '"
Dim zahl As Integer '"
Dim zaehler As Integer '"
Dim timer As Date '"
Cells.Clear 'clrscr
Range(Cells(1, 1), Cells(1, 7)).MergeCells = True 'Verbinden einiger Zellen fuer Formatierung
Range(Cells(2, 1), Cells(2, 2)).MergeCells = True '"
Range(Cells(3, 1), Cells(3, 2)).MergeCells = True '"
Range(Cells(4, 1), Cells(4, 2)).MergeCells = True '"
Range(Cells(4, 7), Cells(4, 8)).MergeCells = True '"
Cells(1, 1).Value = "Primzahlen-Tabelle[FSIAL-LS2-Aufgabe-40] von Thomas Kuehne" 'Überschrift schreiben und formatieren
Cells(1, 1).Font.Bold = True '"
Cells(1, 1).Font.Underline = True '"
Cells(1, 1).Font.Size = 16
Range(Cells(2, 1), Cells(2, 2)).Value = "Obergrenze:" '"Obergrenze" ausgeben und formatieren
Range(Cells(2, 1), Cells(2, 2)).Font.Bold = True '"
Range(Cells(2, 1), Cells(2, 2)).Borders.LineStyle = xlDouble '"
Range(Cells(3, 1), Cells(3, 2)).Value = "Spalten:" '"Spaltenanzahl" ausgeben und formatieren
Range(Cells(3, 1), Cells(3, 2)).Font.Bold = True '"
Range(Cells(3, 1), Cells(3, 2)).Borders.LineStyle = xlDouble '"
Range(Cells(4, 1), Cells(4, 2)).Value = "Primzahlen:" 'Anzahl Primzahlen ausgeben und formatieren
Range(Cells(4, 1), Cells(4, 2)).Font.Bold = True '"
Range(Cells(4, 1), Cells(4, 2)).Borders.LineStyle = xlDouble '"
Range(Cells(4, 1), Cells(4, 2)).Font.ColorIndex = 3 '"
Range(Cells(4, 7), Cells(4, 8)).Value = "Berechnung dauerte:" 'Angabe Berechnungszeit
Range(Cells(4, 7), Cells(4, 8)).Font.Bold = True '"
Range(Cells(4, 7), Cells(4, 8)).Borders.LineStyle = xlDouble '"
obergr = Application.InputBox("Obergrenze eingeben") 'Aufrufen der Inputboxen und Anzeigen der Eingaben, <=0 und > 30000 bzw 1000, Nicht-Zahlen und "leer" ist Fehleingabe
If obergr <= 0 Or obergr > 30000 Or Not IsNumeric(obergr) Or Empty Then '"
MsgBox ("Eingabe geht nicht! 10 wird eingesetzt!") '"
obergr = 10 'Ersatzwert fuer Fehleingabe setzen, Obergrenze = 10
End If '"
Cells(2, 3).Value = obergr '"
Cells(2, 3).Borders.LineStyle = xlDouble '"
spaltenanz = Application.InputBox("Spaltenanzahl eingeben") '"
If spaltenanz <= 0 Or spaltenanz > 1000 Or Not IsNumeric(spaltenanz) Or Empty Then '"
MsgBox ("Eingabe geht nicht! 1 wird eingesetzt") '"
spaltenanz = 1 'Ersatzwert fuer Fehleingabe setzen, Spaltenanzahl = 1
End If '"
Cells(3, 3).Value = spaltenanz '"
Cells(3, 3).Borders.LineStyle = xlDouble '"
zahl = 1 'Startwerte festlegen
zeile = 6 '"
zaehler = 0 '"
timer = Now() 'Timer: Zeitpunkt vor Durchlaufen der Schleifen feststellen
Do Until zahl > obergr 'Beginn Hauptschleife,Do Until -> Loop, kopfgesteuert: Hochzaehlen der Zahlen bis Obergrenze
For spalte = 1 To spaltenanz 'Beginn Unterschleife,For: Hochzaehlen der Spalten bis Spaltenanzahl
If zahl > obergr Then 'Abfrage: Wenn "Zahl" groesser "Obergrenze"
Exit For 'Dann verlasse die Unterschleife
End If 'Ende Abfrage
Cells(zeile, spalte).Value = zahl 'Formatierung der Ausgabe
Cells(zeile, spalte).Borders.LineStyle = xlDouble '"
If Primz(zahl) = True And zahl > 1 Then 'Abfrage: Ist "Zahl" eine Primzahl!? [Funktion aufrufen zum testen] und * groesser als 1?
zaehler = zaehler + 1 'Dann zaehle den Primzahlenzaehler eins hoch
Cells(zeile, spalte).Font.ColorIndex = 3 'Formatierung der Ausgabe der Primzahlen
Cells(zeile, spalte).Font.Bold = True '"
End If 'Ende Abfrage
zahl = zahl + 1 'Zaehle Zahl eins hoch
Next 'Ende Unterschleife
zeile = zeile + 1 'Springe eine Zeile weiter nach unten
Loop 'Wiederhole bis Bedingung in Beginn Hauptschleife
If zaehler <= 0 Then 'Abfrage: Anzahl Primzahlen <= 0
Cells(4, 3).Value = "EINGABE?!" 'JA -> Eingaben passen nicht!
Cells(4, 3).Font.ColorIndex = 3 'Formatierung der Zellen
Cells(4, 3).Font.Bold = True '"
Cells(4, 3).Borders.LineStyle = xlDouble '"
Else 'Sonst
Cells(4, 3).Value = zaehler 'Nein -> Eingaben OK, Primzahlen wurden in Anzahl "zaehler" ermittelt
Cells(4, 3).Font.ColorIndex = 3 'Formatierung der Zellen
Cells(4, 3).Font.Bold = True '"
Cells(4, 3).Borders.LineStyle = xlDouble '"
End If 'Ende Abfrage
Cells(4, 9).Value = Format(Now() - timer, "hh:mm:ss") 'Ausgabe Timer: Zeitpunkt nach Schleifen - Zeitpunkt vor Schleifen
Cells(4, 9).Font.Bold = True '"
Cells(4, 9).Borders.LineStyle = xlDouble '"
End Sub 'Ende Makro
Sub clrscr()
Cells.Clear 'clrscr
Cells(1, 1).Value = "Primzahlen-Tabelle[FSIAL-LS2-Aufgabe-40] von Thomas Kuehne" 'Überschrift schreiben und formatieren
Cells(1, 1).Font.Bold = True '"
Cells(1, 1).Font.Underline = True '"
Cells(1, 1).Font.Size = 16
End Sub
Function Primz(zahl As Integer) As Boolean 'Start Funktion "Bin ich eine Primzahl?" als Boolean[true/false] fuer Abfrage in Makro
Dim i As Integer 'Variable definieren
Primz = True 'Es ist eine Primzahl!
For i = 2 To Int(Sqr(zahl)) 'Schleife: Von 2 bis Wurzel von "zahl" ohne Nachkommastellen
If (zahl Mod i) = 0 Then 'Abfrage: Wenn von "zahl" durch "i" der Rest 0
Primz = False 'ist es doch keine Primzahl!
Exit Function 'Beende Function
End If 'Ende Abfrage
Next 'Ende Schleife
End Function 'Ende Funktion
'06.01.2014 20.08Uhr
|