|
Hey Rene,
anbei ein paar Übungsaufgaben für dich...
Option Explicit
Dim umfang As Integer
Dim laenge As Integer
Dim breite As Integer
Private Const faktor = 2
Sub BerechneUmfang()
' Umfang eines Rechtecks nach der Formel Umfang = 2*(a+b) bestimmen
umfang = faktor * (laenge + breite)
End Sub
Sub EingabeDialog()
' Eingabewerte ermitteln
laenge = InputBox("Bitte geben Sie die Länge des Rechtecks ein: ", "Eingabe", 10)
breite = InputBox("Bitte geben Sie die Breite des Rechtecks ein: ", "Eingabe", 5)
End Sub
Sub Berechnung()
' startet den Eingabedialog und die Berechnung
Call EingabeDialog 'oder ohne call! Ist eine Anweisung für den Aufruf von Prozeduren
BerechneUmfang
MsgBox "Der Umfang des Rechtecks beträgt " & umfang & " Meter.", vbInformation, "Ausgabe"
End Sub
_________________________________________________________________________________________________________________________
Option Explicit
Sub damenSchreiben()
'Aktivierung des gewünschten Arbeitsblattes
Dim ws As Worksheet
Set ws = Worksheets("Tabelle1")
ws.Select
Dim N As Integer
N = InputBox("N:")
Dim spalte As Integer
Dim zeile As Integer
Dim eingabe As String
'Textdatei
Open "Pfad" For Output As #1
'Größe der Matrix
For zeile = 1 To N
'Zeile 1 bis N
eingabe = ""
For spalte = 1 To N
'Spalte 1 bis N"
eingabe = eingabe & Cells(zeile, spalte) & ","
Next
'Dateinummer, dann folgt der Inhalt
Print #1, eingabe
Next
'Close bezieht sich auf Print
Close #1
End Sub
___________________________________________________________________________________________________________________________
Option Explicit
Sub damenzurück()
Dim ws As Worksheet
Set ws = Worksheets("Tabelle2")
ws.Select
Dim N As Integer
N = InputBox("N:")
Dim spalte As Integer
Dim z As Integer 'Zähler der Zeile
Dim s As Integer 'Zähler der Spalte
Dim zeile As String
Dim fertig() As String
Open "Pfad" For Input As #1
For z = 1 To N
Line Input #1, zeile
fertig = Split(zeile, ",")
For s = 1 To N
'Debug.Print fertig(s)
Cells(z, s) = fertig(s - 1)
Next s
Next z
Close #1
End Sub
___________________________________________________________________________________________________________________________
Option Explicit
Sub DoWhile()
Dim Zahl As Double
Dim Weiter As Byte
Zahl = 0
Weiter = vbYes 'Wenn ich hier vbNo mache dann führt er garnicht aus, weil er vor dem ausführen die Bedingung prüft!
Do While Weiter = vbYes 'geht auch => Do Until Weiter = vbNo
Zahl = Zahl + InputBox("Bitte geben Sie eine Zahl ein: ", "Rechner", 1)
Weiter = MsgBox("Weitere Zahlen eingeben?", vbYesNo, "Rechner")
Loop
MsgBox "Die Summe der eingegebenen Zahlen lautet " & Zahl, , _
"Ergebnis der Berechnung"
End Sub
____________________________________________________________________________________________________________________________
Option Explicit
Sub EinseitigeIf()
Dim Betrag As Currency
Dim Rabatt As Currency
Betrag = InputBox("Bitte geben Sie den Betrag ein:")
If Betrag >= 100 Then
Rabatt = Betrag * 0.05
Betrag = Betrag - Rabatt
End If
MsgBox "Kosten: " & Betrag & "€"
End Sub
____________________________________________________________________________________________________________________________
Option Explicit
Sub Fakultät()
Dim i As Integer
Dim Zahl As Integer
Dim Fakultaet As Long
Zahl = InputBox("Bitte geben Sie eine Zahl ein:", "Fakultätsberechnung")
' Fakultät initialisieren 0! = 1
Fakultaet = 1
' Fakultät berechnen
For i = 2 To Zahl
Fakultaet = Fakultaet * i
Next i
MsgBox Zahl & "! = " & Fakultaet, , "Fakultätsberechnung"
End Sub
_____________________________________________________________________________________________________________________________
Option Explicit
Sub Zahlenausgeben1()
Dim i As Integer
For i = 1 To 10
ActiveWorkbook.Worksheets(1).Cells(i, 1) = i
Next i
End Sub
____________________________________________________________________________________________________________________________
Option Explicit
Sub Zahlenausgeben2()
Dim Feld(1 To 15) As Integer, i As Integer
Dim x As Variant
For i = 1 To 15
Feld(i) = i ^ 2
Next i
i = 1
For Each x In Feld
ActiveWorkbook.Worksheets(2).Cells(i, 2) = x
i = i + 1
Next x
End Sub
____________________________________________________________________________________________________________________________
Option Explicit
Sub GeradeUngerade()
Dim Zahl As Integer
Dim eingabe As String
eingabe = InputBox("Bitte geben Sie eine Zahl ein!", "Eingabe", 10)
If IsNumeric(eingabe) Then
Zahl = CInt(eingabe) ' Cint Castoperator um ein Wert in den Typ Integer zu setzen
If Zahl Mod 2 = 0 Then ' Mod Operator: Guckt ob ein Rest bei Division durch 2 übrig bleibt
MsgBox "Gerade Zahl!", vbInformation, "Ausgabe"
Else
MsgBox "Ungerade Zahl!", vbCritical, "Ausgabe"
End If
Else
MsgBox "Bitte geben Sie eine Zahl ein!", vbCritical, "Ausgabe"
End If
End Sub
__________________________________________________________________________________________________________________________
Option Explicit
Sub IstPeterCool()
Dim frage As String
frage = MsgBox("Ist Peter cool?", vbQuestion + vbYesNo, "Fragestellung") 'mit Rückgabewert weil Klammern S.69
If frage = vbYes Then
MsgBox "Du bist cool!", vbInformation, "Feststellung" 'ohne Rückgabewert wenn keine Klammern S.70-71 (Ja oder nein)
Else
MsgBox "Du bist ein Opfer!", vbCritical, "Feststellung"
End If
End Sub
_____________________________________________________________________________________________________________________________
Option Explicit
Sub TestFunctionMaxSuchen()
Dim Werte(1 To 10) As Integer
Dim i As Integer
Dim Max As Integer
Dim s As String
For i = 1 To 10
Werte(i) = Int(101 * Rnd)
' Werte als String verketten
s = s & " " & Werte(i)
Next i
' Maximum ermitteln
Max = MaxSuchen(Werte)
MsgBox s & vbCrLf & " Das Maximum ist " & Max
End Sub
Function MaxSuchen(Feld() As Integer) As Integer
Dim x As Variant, Max As Integer
Max = 0
For Each x In Feld
If x > Max Then Max = x 'wenn eine Zahl das aktuelle Maximum übersteigt, dann wird die neue Zahl das Maximum
Next x
MaxSuchen = Max
End Function
_____________________________________________________________________________________________________________________________
Option Explicit
Sub TestProzedurMaxSuchen2()
Dim Werte(1 To 10) As Integer
Dim i As Integer
Dim Max As Integer
Dim Pos As Integer
Dim s As String
For i = 1 To 10
Werte(i) = Int(101 * Rnd)
s = s & " " & Werte(i)
Next i
MaxSuchen2 Werte, Max, Pos
MsgBox s & vbCrLf & " Das Maximum ist " & Max & " an der Position " & Pos
End Sub
Sub MaxSuchen2(Feld() As Integer, Max As Integer, Pos As Integer)
Dim x As Variant
Dim i As Integer
Max = 0
Pos = 0
i = 1
For Each x In Feld
If x > Max Then
Max = x
Pos = i
End If
i = i + 1
Next x
End Sub
____________________________________________________________________________________________________________________
Option Explicit
Sub RabattBerechnen3()
Dim Betrag As Currency
Dim Rabatt As Currency
Betrag = InputBox("Bitte geben Sie den Betrag ein:", , 100)
If Betrag < 100 Then
MsgBox "Ab einem Betrag von 100 € erhalten Sie 5% Rabatt", vbInformation
Rabatt = 0
ElseIf Betrag < 250 Then
Rabatt = 0.05
ElseIf Betrag < 500 Then
Rabatt = 0.1
Else
Rabatt = 0.12
End If
Betrag = Betrag - Betrag * Rabatt
MsgBox "Endpreis " & Betrag & " € "
End Sub
_________________________________________________________________________________________________________________________
Option Explicit
Sub Modulo()
Dim Zahl As Long
Dim teiler As Integer
Zahl = CLng(InputBox("Bitte die Zahl eingeben!", "Eingabedialog"))
teiler = CInt(InputBox("Bitte den Teiler eingeben!", "Eingabedialog"))
If Zahl Mod teiler = 0 Then
MsgBox "Ist teilbar!", vbInformation, "Ausgabedialog"
Else: MsgBox "Ist nicht teilbar!", vbCritical, "Ausgabedialog"
End If
End Sub
____________________________________________________________________________________________________________________________
Option Explicit
Sub Namenermittlung()
Dim Vorname As String
Dim Nachname As String
Vorname = InputBox("Bitte geben Sie Ihren Vornamen ein:", "Eingabe")
Nachname = InputBox("Bitte geben Sie Ihren Nachnamen ein:", "Eingabe")
MsgBox "Ihr Name lautet " & Vorname & " " & Nachname & ".", vbInformation, "Ausgabe"
End Sub
_________________________________________________________________________________________________________________________
Option Explicit
Public Sub Zeichenfolgen()
' Variablendeklarationen
Dim Vorname As String
Dim Nachname As String
Dim Geburtsdatum As Date
' Werte zuweisen
Vorname = "Lisa"
Nachname = "Lang"
Geburtsdatum = #1/14/1993#
' Meldung ausgeben
MsgBox "Frau " & Vorname & " " & Nachname & " ist am " & Geburtsdatum & " geboren.", , "Ausgabe"
End Sub
Public Sub ZeitBerechnung()
' Variablendeklarationen
Dim Anfangszeit As Date
Dim Endezeit As Date
' Werte zuweisen
Anfangszeit = "7:30:00"
Endezeit = Anfangszeit + "9:00:00 AM"
' Meldung ausgeben
MsgBox "Endezeit: " & Endezeit, , "Ausgabe"
End Sub
_____________________________________________________________________________________________________________________________
Option Explicit
Sub TestPotenzieren()
MsgBox "dritte Potenz von 8 = " & Potenzieren(8, 3)
MsgBox "zweite Potenz von 8 = " & Potenzieren(8)
'Test zweiter Teil
MsgBox "8 hoch 0 = " & Potenzieren2(8, 0)
MsgBox "8 hoch -1 = " & Potenzieren2(8, -1)
MsgBox "8 hoch -3 = " & Potenzieren2(8, -3)
End Sub
Function Potenzieren(Zahl As Double, Optional Potenz As Integer = 2) As Double
Dim i As Integer
Potenzieren = Zahl
For i = 2 To Potenz
Potenzieren = Potenzieren * Zahl
Next i
End Function
Function Potenzieren2(Zahl As Double, Optional Potenz As Integer = 2) As Double
Dim i As Integer
If Potenz = 0 Then
Potenzieren2 = 1
Exit Function
ElseIf Potenz > 0 Then
Potenzieren2 = Zahl
For i = 2 To Potenz
Potenzieren2 = Potenzieren2 * Zahl
Next i
Else
Potenzieren2 = 1 / Zahl
For i = -2 To Potenz Step -1
Potenzieren2 = Potenzieren2 * (1 / Zahl)
Next i
End If
End Function
____________________________________________________________________________________________________________________________
Option Explicit
Sub quadratzahl()
Dim eingabe As String
Dim Zahl As Integer
Dim quadratzahl As Integer
eingabe = InputBox("Geben Sie die Zahl ein:")
If IsNumeric(eingabe) Then
Zahl = CInt(eingabe)
quadratzahl = Zahl * Zahl
Else: MsgBox "Bitte eine Zahl eingeben!"
Exit Sub
End If
MsgBox "Das Quadrat der Zahl " & Zahl & " ist: " & quadratzahl
End Sub
____________________________________________________________________________________________________________________________
Option Explicit
Sub Spiegeln()
Dim mZeilen As Integer
Dim nSpalten As Integer
Dim werteBereich As Range
Dim einfügeBereich As Range
Dim i As Integer
Dim j As Integer
mZeilen = CInt(InputBox("Bitte Anzahl Zeilen eingeben!"))
nSpalten = CInt(InputBox("Bitte Anzahl Spalten eingeben!"))
Set werteBereich = Range(Cells(1, 1), Cells(mZeilen, nSpalten))
Set einfügeBereich = Range(Cells(1, nSpalten + 1), Cells(mZeilen, nSpalten + 1)) 'anstatt +1 => + nSpalten
For i = 1 To mZeilen
For j = 1 To nSpalten
einfügeBereich.Cells(i, nSpalten + 1 - j).Value = werteBereich.Cells(i, j).Value
Next j
Next i
End Sub
__________________________________________________________________________________________________________________________
Option Explicit
Sub test()
Const euroInzloty = 3.95 'Variant
Const test As Integer = 11 'Integer
Dim x, y As Integer 'x ist Variant da nicht deklariert
Dim v1 As Integer, v2 As Double, v3 As String
Dim z As Integer
Dim o As Double
Dim rechnung As Integer
Dim Potenz As Integer
Dim a As Integer, b As Integer, ganzzahligedivision As Integer
Dim zahlenarray(1 To 100) As Integer 'array mit 100 Werten
Dim frage As String
a = 2
b = 3
y = 1000
ganzzahligedivision = 9 \ 4
rechnung = (5 - 2) * 3 '9 kommt raus weil Klammern die höchste Prirität haben!
Potenz = a ^ b 'Leerzeichen muss dazwischen sein
frage = InputBox("Wie gehts dir?", "Frage") 'Rückgabe von InputBox ist String
MsgBox ganzzahligedivision
MsgBox Potenz
MsgBox rechnung
MsgBox z 'Standardwert von integer ist 0
MsgBox x 'Standardwert von variant ist Leer
MsgBox o 'Standardwert von double ist 0
End Sub
__________________________________________________________________________________________________________________________
Option Explicit
Sub testeAusgabe()
Open "PFAD" For Output As #1
Print #1, "Nur ein Test"
Print #1, "Und; ein; weiterer; Test"
Close #1
End Sub
_________________________________________________________________________________________________________________________
Option Explicit
Sub testeEinlesen()
Dim zeile As String
Open "PFAD" For Input As #1
Do While Not EOF(1)
Line Input #1, zeile
MsgBox ("Die eingelesene Variable hat den Wert: " & zeile)
Loop
Close #1
End Sub
_________________________________________________________________________________________________________________________
Option Explicit
Sub tictactoe()
If ThisWorkbook.Worksheets("Tabelle4").Cells(1, 1) = "x" And ThisWorkbook.Worksheets("Tabelle4").Cells(1, 2) = "x" And ThisWorkbook.Worksheets("Tabelle4").Cells(1, 3) = "x" Then
MsgBox "x hat gewonnen"
ElseIf ThisWorkbook.Worksheets("Tabelle4").Cells(2, 1) = "x" And ThisWorkbook.Worksheets("Tabelle4").Cells(2, 2) = "x" And ThisWorkbook.Worksheets("Tabelle4").Cells(2, 3) = "x" Then
MsgBox "x hat gewonnen"
End If
'und so weiter
End Sub
__________________________________________________________________________________________________________________________
Option Explicit
Sub TestProzedurVertausche()
Dim Zeichen1 As String
Dim Zeichen2 As String
Zeichen1 = InputBox("Bitte geben Sie eine Zeichenkette ein:")
Zeichen2 = InputBox("Bitte geben Sie eine zweite Zeichenkette ein:")
Vertausche Zeichen1, Zeichen2
MsgBox "Zeichenkette1: " & Zeichen1 & vbCrLf & "Zeichenkette2: " & Zeichen2
End Sub
'Sub Vertausche(ByVal s1 As Variant, ByVal s2 As Variant) 'Parameterübergabe als Wert (by Value) er tauscht nicht!
Sub Vertausche(ByRef s1 As Variant, ByRef s2 As Variant) 'Parameterübergabe als Referenz (by Reference)
Dim sTemp As Variant
sTemp = s1
s1 = s2
s2 = sTemp
End Sub
____________________________________________________________________________________________________________________________
Option Explicit
Sub Zellenausgabe()
Dim zeile As Integer
Dim spalte As Integer
Dim eingabe As String
Dim groesse As Integer
eingabe = InputBox("Bitte die Größe eingeben!") 'Eingabedialog
'groesse = 5 'wenn man eine feste Größe benutzen möchte!
If IsNumeric(eingabe) Then
groesse = CInt(eingabe)
Else
MsgBox "Bitte geben Sie eine Zahl ein!"
End If
For zeile = 1 To groesse
For spalte = 1 To groesse
ThisWorkbook.Worksheets("Tabelle1").Cells(zeile, spalte) = "(" & zeile & ", " & spalte & ")"
Next spalte
Next zeile
End Sub
_____________________________________________________________________________________________________________________
Option Explicit
Sub Zellenmultiplikation()
Dim zeile As Integer
Dim spalte As Integer
Dim eingabe As String
Dim groesse As Integer
eingabe = InputBox("Wie groß soll das Feld sein?")
If IsNumeric(eingabe) Then
groesse = CInt(eingabe)
Else
MsgBox "Bitte geben Sie eine Zahl ein!"
End If
For zeile = 1 To groesse
For spalte = 1 To groesse
ThisWorkbook.Worksheets("Tabelle2").Cells(zeile, spalte) = zeile * spalte
Next spalte
Next zeile
End Sub
___________________________________________________________________________________________________________________________
Option Explicit
Sub zerlegeText()
Dim text As String
Dim zerlegterText() As String
text = "Dies,ist,ein,Text"
zerlegterText = Split(text, ",")
For i = 0 To UBound(zerlegterText)
Debug.Print zerlegterText(i)
Next i
End Sub
________________________________________________________________________________________________________________________
Option Explicit
Sub ZweiseitigeIf()
Dim Betrag As Currency
Dim Rabatt As Currency
Betrag = InputBox("Bitte geben Sie den Betrag ein:", , 100)
If Betrag >= 100 Then
Rabatt = Betrag * 0.05
Betrag = Betrag - Rabatt
MsgBox "Der Endpreis beträgt " & Betrag & " €."
Else
MsgBox "Der Endpreis beträgt " & Betrag & " €." & vbCrLf & vbLf & _
"Ab einem Betrag von 100 € erhalten Sie 5 % Rabatt."
End If
End Sub
_________________________________________________________________________________________________________________________
Hoffe die Programme helfen dir weiter!
Gruß
Micha
|