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"
)
Fakultaet = 1
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)
If
Zahl
Mod
2 = 0
Then
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"
)
If
frage = vbYes
Then
MsgBox
"Du bist cool!"
, vbInformation,
"Feststellung"
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)
s = s &
" "
& Werte(i)
Next
i
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
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()
Dim
Vorname
As
String
Dim
Nachname
As
String
Dim
Geburtsdatum
As
Date
Vorname =
"Lisa"
Nachname =
"Lang"
Geburtsdatum = #1/14/1993#
MsgBox
"Frau "
& Vorname &
" "
& Nachname &
" ist am "
& Geburtsdatum &
" geboren."
, ,
"Ausgabe"
End
Sub
Public
Sub
ZeitBerechnung()
Dim
Anfangszeit
As
Date
Dim
Endezeit
As
Date
Anfangszeit =
"7:30:00"
Endezeit = Anfangszeit +
"9:00:00 AM"
MsgBox
"Endezeit: "
& Endezeit, ,
"Ausgabe"
End
Sub
_____________________________________________________________________________________________________________________________