Hilfe bei Visual Basic

[bat1nh]

Hallo zusammen,
ich braeuchte mal Eure Hilfe, und zwar hab ich seit zwei Wochen Informatik und wir behandeln im Moment VBA in Excel.
Ich hab jetzt drei Uebungsaufgaben, die ich loesen soll, weiß aber nicht wirklich wie ich das anstellen soll. Hab schon alles moegliche probiert, aber irgendwie klappt das alles nicht so wie ich es haben will. Hatte vorher noch nie Programmiert.
Ich waere Euch sehr dankbar.

PS: Ich konnte das Thema nicht wirklich zuordnen, hoffe es ist hier richtig.

Hier die Aufgaben:

Aufgabe 1:

Schreiben Sie ein VBA-Programm: Teilen Sie die Zahl 123456 so lange durch 2,5, bis das Ergebnis kleiner als 1 ist und geben Sie die Anzahl der Durchläufe aus sowie das Ergebnis aus.

Aufgabe 2:

Erzeugen Sie mit Hilfe einer geschachtelten For-Next Schleife Zufallszahlen von 0 bis 100 für x Spalten und y Zeilen. Überprüfen Sie dann, ob die Zahlen größer z sind und markieren sie die Zellen entweder rot oder blau. Lassen Sie den Anwender x, y und z eingeben und überprüfen Sie die drei Variablen auf Plausibilität (x,y < 100, 0 < z < 100).

Funktion zur Erzeugung von Zufallszahlen 0 bis 100: Dim zufall As Integer
zufall = int(100 * Rnd)

Aufgabe 3:

Schreiben Sie ein VBA-Programm, das den Body Mass Index (BMI) des Anwenders berechnet!
• Ein- und Ausgaben werden in einer Prozedur realisiert.
• Die eigentliche Berechnung soll in einer eigenen Funktion BMI stattfinden.
• Die Eingabe der Werte soll über Eingabe-Dialoge realisiert werden.
• Der Anwender soll nur Werte 20kg - 150kg und 1,0m - 2,5m eingeben dürfen (Dialoge
in while-Schleifen)
• Der Anwender soll neben dem Index als Zahl auch erfahren, ob er/sie untergewichtig
(BMI<18,5), übergewichtig (BMI>25,0) ist oder ob der BMI im Normalbereich liegt.

 

[awk]

Stelle konkrete Fragen. Solltest du irgendwo hängen, dann zeige uns den bisherigen Code.
Gehe es schrittweise an, Beispiel 2 wird dir nahezu vorgegeben: 2 Schleifen --> if --> auf die Zelle zugreifen.

Also: sieh in deiner Mitschrift nach, was eine Schleife ist, überlege weswegen man 2 ineinander schachteln muss, sieh in deiner Mitschrift nach wie man etwas in eine Zelle schreibt. Dann ist der 1. Teil schon wieder erledigt. Dann überlege dir noch, wie man die if-Abfrage formuliert und wie man eine Zelle markiert. Fertig. Solltest du bei einem dieser Schritte hängen, dann teile es uns mit.

 

[bat1nh]

Hallo awk,
danke fuer deine schnelle Antwort, ich hab leider die "Programmierung" nicht gespeichert, da sie Unbrauchbar waren. Zu der Aufgabe 1, hab ich folgendes heraus:

Sub teilen()
Dim Zahl As Double
Dim Counter As Integer

Zahl = 123456
Counter = 0
Do
Zahl = Zahl / 2.5
Counter = Counter + 1
Loop While Zahl > 1
MsgBox (Zahl & " Durchläufe : " & Counter)
End Sub

Denke das ist so gemeint? Oder? Ich werd mich mal an die Aufgabe 2 und 3 heranbegeben und danke fuer deine Loesungsansaetze. Ich werd mich melden, wenn ich weitere Fragen hab.

 

[Kaffeeschlampe]

Prob 2:

Option Explicit

Sub ErstelleBunteMatrix()

Dim sReturn As String
Dim iZeilen As Long
Dim iReihen As Long
Dim iSchwellwert As Long
Dim mySheet As Excel.Worksheet: Set mySheet = Me
Dim iRnd As Long
Dim i, j As Long

' Sheet leeren
mySheet.Range(mySheet.Cells(1, 1), mySheet.Cells(100, 100)).Clear

' Werte abfragen
sReturn = InputBox("Bitte Anzahl der Zeilen angeben:", "Eingabe")
If Not IsNumeric(sReturn) Then Call MsgBox("Abbruch: Keine Zahl."):                         Exit Sub
iZeilen = CInt(sReturn)
If iZeilen < 1 Or iZeilen > 100 Then Call MsgBox("Abbruch: Ausserhalb Bereich."):           Exit Sub

sReturn = InputBox("Bitte Anzahl der Reihen angeben:", "Eingabe")
If Not IsNumeric(sReturn) Then Call MsgBox("Abbruch: Keine Zahl."):                         Exit Sub
iReihen = CInt(sReturn)
If iReihen < 1 Or iReihen > 100 Then Call MsgBox("Abbruch: Ausserhalb Bereich."):           Exit Sub

sReturn = InputBox("Bitte Schwellwert:", "Eingabe")
If Not IsNumeric(sReturn) Then Call MsgBox("Abbruch: Keine Zahl."):                         Exit Sub
iSchwellwert = CInt(sReturn)
If iSchwellwert < 0 Or iSchwellwert > 100 Then Call MsgBox("Abbruch: Ausserhalb Bereich."):      Exit Sub

' aussere Schleife
For i = 1 To iReihen
  
  ' innere Schleife
  For j = 1 To iZeilen
  
    ' Zelle mit Zufallszahl füllen
    iRnd = CInt(100 * Rnd)
    mySheet.Cells(i, j).Value = iRnd
    
    ' Farbe
    If iRnd > iSchwellwert Then
      mySheet.Cells(i, j).Interior.Color = RGB(255, 0, 0)
    Else
      mySheet.Cells(i, j).Interior.Color = RGB(0, 0, 255)
    End If
  Next j
Next i

' Spaltenbreite automatisch anpassen (bessere Übersicht)
mySheet.UsedRange.EntireColumn.AutoFit

Call MsgBox("Fertig")
End Sub

 

[Kaffeeschlampe]

wenn du natürlich ein krasser Hengst sein willst, kann du das ganz auch Zeitlich optimieren. Anstatt die Zellen Spalten- und Reihenweise zu füllen, schreibt du das ganze erst in ein dynamisches Array und weist dieses denn der identischen Excel Range hinzu. Das geht bei den 100x100 Matrixen superschnell.

Um denn noch die Farben zu bekommen, arbeitest du mit einer bedingten Formatierung auf der Range und überlässt Excel die Arbeit.

Option Explicit

Sub ErstelleBunteMatrix()

Dim sReturn As String
Dim iZeilen As Long
Dim iReihen As Long
Dim iSchwellwert As Long
Dim mySheet As Excel.Worksheet: Set mySheet = Me
Dim iRnd As Long
Dim i, j As Long
Dim myArray() As Long

' Sheet leeren
mySheet.Range(mySheet.Cells(1, 1), mySheet.Cells(100, 100)).Clear

' bedingte Formatierungen entfernen
mySheet.Cells.FormatConditions.Delete

' Werte abfragen
sReturn = InputBox("Bitte Anzahl der Zeilen angeben:", "Eingabe")
If Not IsNumeric(sReturn) Then Call MsgBox("Abbruch: Keine Zahl."):                         Exit Sub
iZeilen = CInt(sReturn)
If iZeilen < 1 Or iZeilen > 100 Then Call MsgBox("Abbruch: Ausserhalb Bereich."):           Exit Sub

sReturn = InputBox("Bitte Anzahl der Reihen angeben:", "Eingabe")
If Not IsNumeric(sReturn) Then Call MsgBox("Abbruch: Keine Zahl."):                         Exit Sub
iReihen = CInt(sReturn)
If iReihen < 1 Or iReihen > 100 Then Call MsgBox("Abbruch: Ausserhalb Bereich."):           Exit Sub

sReturn = InputBox("Bitte Schwellwert:", "Eingabe")
If Not IsNumeric(sReturn) Then Call MsgBox("Abbruch: Keine Zahl."):                         Exit Sub
iSchwellwert = CInt(sReturn)
If iSchwellwert < 0 Or iSchwellwert > 100 Then Call MsgBox("Abbruch: Ausserhalb Bereich."):      Exit Sub

ReDim myArray(iZeilen, iReihen)

' aussere Schleife
For i = 0 To iReihen - 1
  
  ' innere Schleife
  For j = 0 To iZeilen - 1
  
    ' Array mit Zufallszahl füllen
    iRnd = CInt(100 * Rnd)
    myArray(i, j) = iRnd
  Next j
Next i

' Array ins Blatt kopieren - geht fix
mySheet.Range(mySheet.Cells(1, 1), mySheet.Cells(iZeilen, iReihen)).Value = myArray

' Spaltenbreite automatisch anpassen (bessere Übersicht)
mySheet.UsedRange.EntireColumn.AutoFit

' bedingte Formatierung setzen
Call mySheet.UsedRange.FormatConditions.Add(Type:=xlCellValue, Operator:=xlGreater, Formula1:="=" & iSchwellwert)
Call mySheet.UsedRange.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
mySheet.UsedRange.FormatConditions(1).Interior.Color = RGB(255, 0, 0)

Call mySheet.UsedRange.FormatConditions.Add(Type:=xlCellValue, Operator:=xlLessEqual, Formula1:="=" & iSchwellwert)
Call mySheet.UsedRange.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
mySheet.UsedRange.FormatConditions(1).Interior.Color = RGB(0, 0, 255)

Call MsgBox("Fertig")
End Sub

 

[bat1nh]

Hi Kaffeeschlampe,
wow! Danke fuer die Programmierung, bin aber leider noch nicht soweit, dass ich das alles verstehen kann. Ich werde versuchen, das irgendwie herauszufiltern bzw zu entziffern, was zu was gehoert. Ich danke dir fuer die Muehe.
Wie lange programmierst du schon?

 

[Kaffeeschlampe]

seit meinem Studium, insgesamt jetzt fast 10 Jahre. Angefangen mit C++ und Qt in Linux, jetzt vb.net unter Windows.

Wenn du noch Fragen zum Code hast, frage einfach.

 

[bat1nh]

Hi Kaffeeschlampe,
nochmals Danke fuer deine Muehe. Ich habe mir deine Programmierung angeguckt und es war soweit "verstaendlich". Hab jetzt auch die einfachere Version davon.
Ich werd mich melden, falls irgendwann nochmal Fragen auftauchen sollte.