Excel aufmöbeln mit VBA

Tabelle1
Tabelle3

Tabelle1
Tabelle3

Tabelle1
Tabelle3

•

+
•
•
•
•
•
•

•
•
•
•
+
•
← → ↑ ↓
•
•

•
+
+
+

•
+
+
+

+

•
•
•

•
•
•

+
+
+ +
−−→ −−→
⇑ +−−→ −−→
+−−→ −−→ ⇑ + +−−→ −−→
+−−→ −−→
+

•
•

•
←↪
+ ←↪

+
+
+ ⇑ +
+
•
•

+
+
+ ⇑ +
+
•
•

← → ↑ ↓
+ ←

+ ←
+ ↑
+ ↓
↑
↓
+ ↑
+ ↓
+
+
+ ↑
+ ↓

+ ←↪
+

⇑
← → ↑ ↓
⇑ +
+
⇑
⇑ ⇑ +
⇑
⇑ +

+
e

+
e

+
e

+
e

⇑

+−−→ −−→

+−−→ −−→

+−−→ −−→

+
←↪
+
+

+

+

+

K0
r = 8
Kn = K0(1+r) n r
K0 n
Kn = K0(1 + nr)
. . .

. . .

e e
1.000 ∗ 10 + 2.000 ∗ 5 = 20.000
= 10 ∗ B2 + 5 ∗ C2
←↪
10∗
+5∗

= 10 ∗ B2 + 5 ∗ C2
e
e
e e
= I2 ∗ B2 + I3 ∗ C2
= $I$2 ∗ B2 + $I$3 ∗ C2
= I$2 ∗ B2 + I$3 ∗ C2.
$I$2 ∗ B3 + $I$3 ∗ C3 = I$2 ∗ B3 +
I$3 ∗ C3

= $H$2 ∗ B2 + $H$3 ∗ C2
A
¡ \ \ ¡ A
+ +

m n
m·n

= K2 ∗ B2 : B13 + K3 ∗ C2 : C13
K2 = 20 K3 = 12
+ ⇑ + ←↪
+ ⇑ + ←↪ ←↪
+ ⇑ + ←↪
¢
¢
= A1&B1,
= A1 > B1,
= A2¢(B2 ∗ C2),
= A2

=
=
=
fx

= B14/12
e e
e e

= B14/12
e e
e e

= B14/12
e e
e e

=
=
+

=

=

n
A B A m · n
B n · k m · k
+ ⇑ + ←↪
=
+ ⇑ + ←↪
A −1 A A
B = A T A A m n
n m bi,j = aj,i
1
2
3
4
A B C D E F G H I J K L M N O
A A Det(A) INDEX($A$2:$C$4;3;2)
4 8 8 - 9/20 - 2/5 4/5 40 8 4 5 6
5 7 11 2/5 - 1/5 - 1/10 8 7 8
6 8 10 - 1/20 2/5 - 3/10 8 11 10
-1
A T

10 = 4 + 6
11 = 3 + 6 + 2
+ ⇑ + ←↪
←↪

1
2
3
4
5
6
7
8
A B C D E F G H I J K
Kzl. Modul SWS H-Geld Kzl. Modul SWS H-Geld Kurs Hörer
ana Analysis 8 60 ana Analysis 8 60 A 34
la Lin. Algebra 6 40 ana Analysis 8 60 B 45
cee C 6 80 la Lin. Algebra 6 40 A 56
dat Datenbanken 6 70 cee C 6 80 A 67
dat Datenbanken 6 70 A 45
dat Datenbanken 6 70 B 37
=SVERWEIS($F2;$A$2:$D$6;SPALTE()-5;FALSCH)
•
•

•
•
•

•
•
1
2
3
4
5
A B C D E F G H I J K L M N O P Q R S T U
Zahlen 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
UG 4
OG 8
Summe 30

1 2
V = .
3 4
+ ⇑ + ←↪
V −1 =
−2 1
.
1, 5 −0, 5
1
2
3
4
5
A B C D E F G H I
Anfangsjahr 2010
Laufzeit 7
Jahre 2010 2011 2012 2013 2014 2015 2016 2017
Sternzeichen Igel Ratte Tiger Drachen Schwein Igel Ratte Tiger

1
2
3
4
5
A B C D E F G H
Anfangsdatum Wochentag Frist Ablaufsdatum Wochentag
10.10.2012 Mi 10 22.10.2012 Mo
=INDEX({"So"."Mo"."Di"."Mi"."Do"."Fr"."Sa"};1;WOCHENTAG(A2))
=WENN(WOCHENTAG(A2)+REST(C2;7)=7;A2+C2+2;WENN(WOCHENTAG(A2)+REST(C2;7)=8;A2+C2+1;A2+C2))

n A
A
n
i
q = 1 + i
t = n
REN = A(q n−1 + q n−2 + · · · + 1) = Asn,
sn = q n−1 + q n−2 + · · · + 1 = qn − 1
,
i
n − 1 n − 2
REN
sn
RAN
q −n
RAN = Aq −n sn,
an = q −n sn.
an
A i n
sn an

+

+ ⇑ +

•
•

←↪ + ⇑ + ←↪

+
+

1
2
3
4
5
6
7
8
9
A B C D E
k Tag Monat Jahr Wochentag
1 1 10 2009 Do
2 2 10 2009 Fr
3 3 10 2009 Sa
4 4 10 2009 So
5 5 10 2009 Mo
6 6 10 2009 Di
7 7 10 2009 Mi
8 8 10 2009 Do
=
=
=
=
=
x 2 − 2x − 3 = 0

x 5 − 2x 3 − 3 = 0
x ↦→ 2x x ↦→ tan x
tan x − 2x = 0.
x
x = 0
x = 1, 16556118520721

0, 0000000001 = 10 −9
10 −4

A B C D E F G H I J
1
2
3
4
Monat
Jan
Feb
Mrz
Bier Limo
350 2000
420 2160
504 2320
Gewinn
in Euro
880,00
984,00
1099,20
4.000
3.500
3.000
Säulendiagramm
5 Apr 604 2480 1227,20 2.500
6 Mai 724 2640 1371,20 2.000
7 Jun 868 2800 1534,40 1.500
8 Jul 1041 2960 1720,80 1.000
9 Aug 1249 3120 1935,20 500
10
11
Sep
Okt
1498 3280
1797 3440
2182,40
2469,60
0
12 Nov 2156 3600 2804,80
13
14
Dez 2587 3760 3197,60
Bier Limo Gewinn
i E
15 Heute Geburtstag Gelebte Tage Alter Uhrzeit
16 07.10.2009 19.01.1971 14141 38 01:03:03
17 Blatt neu berechnen: Taste F9!
Feb
Jan
Dez
Nov
Okt
Sep
Aug
Jul
Jun
Mai
Apr
Mrz
e e
e
e
e
e

1
2
3
4
5
6
7
8
9
10
11
A B C D E F G H I
Name Vorname Geschlecht Gebdat Gatte Kinder FBR Grundgehalt Gehalt
Bulletti Benito M 11.02.1962 0 MaD 4.600 4.700
Eisenbeiß Elfriede W 22.11.1944 Erich 0 SuF 3.450 4.000
Schurigl Schorsch M 13.11.1949 0 MaD 4.800 5.100
Lobedanz Lothar M 25.08.1965 Lola 1 MaD 4.700 5.100
Grün Gero M 13.02.1953 0 SuF 6.000 6.350
Greulich Gitta W 11.11.1972 1 MaD 4.100 4.300
Gründlich Gerda W 15.12.1965 0 SuF 3.800 4.050
Trauerwein Thaddäus M 11.11.1955 Trude 2 MaD 6.000 6.700
Männer 26.100 Frauen 11.350 Σ 37.450 37.900
SuF 13.250 Eltern 14.800 μ 4.681 5.038
1
2
3
4
5
6
A B C D E F
Anfangsjahr Anfangsmonat Laufzeit (Monate) Endjahr Endmonat
2008 6 56 2013 1
7884
Einkommen Gerundet Steuer Jahr Schaltjahr
46299,45 46296 7884 2000 Ja
e
e e e
e e
L R

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
A B C D E F G H I J K L M N O P Q R S T U V W X Y
Matrix L
Matrix R
1 0 0 0 1 3 1 -1 1 3 1 -1 4 -2 7 -5 1 0 0 0
2 1 0 0 0 -1 -1 2 2 5 1 0 -1 1 -3 2 0 1 0 0
3 0 1 0 0 0 1 0 3 9 4 -3 -3 0 1 0 0 0 1 0
4 -1 1 1 0 0 0 1 4 13 6 -5 -3 1 -1 1 0 0 0 1
{=MMULT(L;R)} {=MINV(A)}
MDET(L) 1 MDET(R) -1 MDET(A) -1
A = L*R Inverse A -1
{=MTRANS(A)} A
1 0 0 0 1 3 2 -5 1 2 3 4 4 -2 7 -5
-2 1 0 0 0 -1 -1 2 3 5 9 13 -1 1 -3 2
-3 0 1 0 0 0 1 0 1 1 4 6 -3 0 1 0
-3 1 -1 1 0 0 0 1 -1 0 -3 -5 -3 1 -1 1
-1 =R -1 *L -1
Inverse L -1
Inverse R -1
Matrixformeln: Strg+Umschalt+Eingabe!
A* A -1
(A T ) −1
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
A B C D E F G
Preisliste Kundenliste
ArtikelNr Artikel Preis KundenNr Kunde Rabatt
1 Babypuder Hauchzart 4,50 1 BabyDiscount 10,00%
2 Alete Spuckspinat 2,30 2 BaByHiP 4,00%
3 Ohropax 1,20 3 BabyParadies 13,00%
AuftragsNr ArtikelNr Artikel
Auftragsposten
KundenNr Kunde Anzahl Preis
1 1 Babypuder Hauchzart 2 BaByHiP 12 51,84
2 1 Babypuder Hauchzart 1 BabyDiscount 120 486,00
1 2 Alete Spuckspinat 2 BaByHiP 13 28,70
3 3 Ohropax 3 BabyParadies 800 835,20
Umsatzliste
KundenNr Kunde Gesamter Umsatz
1 BabyDiscount 486,00
2 BaByHiP 80,54
3 BabyParadies 835,20

K0 i n
1
2
3
4
5
6
7
A B C D E F G H
Kapital Zins Laufzeit Zeit Kexp Keinfach Unterschied
5000,00 8,00% 5 01.01.1999 5.000,00 5.000,00 0,00
01.01.2000 5.400,00 5.400,00 0,00
01.01.2001 5.832,00 5.800,00 32,00
01.01.2002 6.298,56 6.200,00 98,56
01.01.2003 6.802,44 6.600,00 202,44
01.01.2004 7.346,64 7.000,00 346,64
Zins
1
2
3
4
5
A B C D E F G H I J K
Vertragsgrundlagen
Wert
Zins 0,0500 Anfangs- Anfangs- Anzahl End- End- Zahltermine Monatlicher
Abschlusskosten 0,0400 jahr monat Monate jahr monat pro Jahr Zahlbeitrag
Monatsfaktor 1,00407 2008 10 38 2011 11 1 250
MonF aktor = (1 + Zins) (1/12) .

alpha
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
A B C D E F G H I J K L M
k
Jahr
Monat
Zahlbeitrag
Alphakosten
Kapital
k
Jahr
Monat
Zahl
beitrag
Alphakosten
1 2008 10 250 10,83 239,17 1 2008 10 3000 130,00 2.870,00
2 2008 11 250 10,83 479,31 2 2008 11 0 0,00 2.881,69
3 2008 12 250 10,83 720,43 3 2008 12 0 0,00 2.893,43
4 2009 1 250 10,83 962,53 4 2009 1 0 0,00 2.905,22
5 2009 2 250 10,83 1.205,62 5 2009 2 0 0,00 2.917,06
6 2009 3 250 10,83 1.449,70 6 2009 3 0 0,00 2.928,94
7 2009 4 250 10,83 1.694,77 7 2009 4 0 0,00 2.940,87
8 2009 5 250 10,83 1.940,84 8 2009 5 0 0,00 2.952,86
9 2009 6 250 10,83 2.187,91 9 2009 6 0 0,00 2.964,89
10 2009 7 250 10,83 2.435,99 10 2009 7 0 0,00 2.976,97
11 2009 8 250 10,83 2.685,09 11 2009 8 0 0,00 2.989,09
12 2009 9 250 10,83 2.935,19 12 2009 9 0 0,00 3.001,27
13 2009 10 250 10,83 3.186,32 13 2009 10 3000 130,00 5.883,50
14 2009 11 250 10,83 3.438,46 14 2009 11 0 0,00 5.907,47
15 2009 12 250 10,83 3.691,64 15 2009 12 0 0,00 5.931,54
16 2010 1 250 10,83 3.945,85 16 2010 1 0 0,00 5.955,70
17 2010 2 250 10,83 4.201,09 17 2010 2 0 0,00 5.979,97
18 2010 3 250 10,83 4.457,37 18 2010 3 0 0,00 6.004,33
19 2010 4 250 10,83 4.714,70 19 2010 4 0 0,00 6.028,79
20 2010 5 250 10,83 4.973,07 20 2010 5 0 0,00 6.053,36
21 2010 6 250 10,83 5.232,50 21 2010 6 0 0,00 6.078,02
22 2010 7 250 10,83 5.492,99 22 2010 7 0 0,00 6.102,78
23 2010 8 250 10,83 5.754,53 23 2010 8 0 0,00 6.127,64
24 2010 9 250 10,83 6.017,14 24 2010 9 0 0,00 6.152,61
25 2010 10 250 0,00 6.291,66 25 2010 10 500 0,00 6.677,68
26 2010 11 250 0,00 6.567,29 26 2010 11 0 0,00 6.704,88
Kapital

x 5 − 2x 3 − 3 = 0, cos(x) = x.

1
2
3
4
5
6
7
8
9
10
11
12
13
A B C D E F G H I
CDU/CSU SPD FDP GRÜNE
1998 40,5 42,5 6,4 7,5
2002 38,5 38,5 7,4 8,5
2005 35,5 34,5 8,4 9,5
2009 33,9 23,5 14,4 12,5
50
40
30
20
10
0
1998
2002
2005
2009
Anteil in %
45
40
35
30
25
20
15
10
5
0
Wahlen 1998 bis 2009
CDU/CSU
SPD
FDP
GRÜNE
1998 2002 2005 2009
Jahr

1
2
3
4
5
6
7
8
9
10
11
12
13
A B C D E F G H I
CDU/CSU SPD FDP GRÜNE
1998 40,5 42,5 6,4 7,5
2002 38,5 38,5 7,4 8,5
2005 35,5 34,5 8,4 9,5
2009 33,9 23,5 14,4 12,5
50
40
30
20
10
0
1998
2002
2005
2009
Anteil in %
45
40
35
30
25
20
15
10
5
0
Wahlen 1998 bis 2009
CDU/CSU
SPD
FDP
GRÜNE
1998 2002 2005 2009
Jahr

1
2
3
4
5
6
7
8
9
10
A B C D E F G H
Anteil
CDU/CSU 38,5
SPD 38,5
FDP 7,4
GRÜNE 8,5
CDU/CSU SPD FDP GRÜNE
40
20
0
38,5 38,5
Anteil in %
7,4
8,5

1
2
3
4
5
6
7
8
9
10
A B C D E F G H
Anteil
CDU/CSU 38,5
SPD 38,5
FDP 7,4
GRÜNE 8,5
CDU/CSU SPD FDP GRÜNE
40
20
0
38,5 38,5
Anteil in %
7,4
8,5

•
•
•

•
•
•

e
1
2
3
4
5
6
7
8
9
10
A B C D E F G H I
1999 2000 2001 2002 2003 2004 2005 2006
Kapital 5.000,00 5.400,00 5.832,00 6.298,56 6.802,44 7.346,64 7.934,37 8.569,12
Zinsen 0 400,00 432,00 466,56 503,88 544,20 587,73 634,75
10.000
8.000
6.000
4.000
2.000
0
1998 1999 2000 2001 2002 2003 2004 2005 2006

e
1
2
3
4
5
6
7
8
9
10
A B C D E F G H I
1999 2000 2001 2002 2003 2004 2005 2006
Kapital 5.000,00 5.400,00 5.832,00 6.298,56 6.802,44 7.346,64 7.934,37 8.569,12
Zinsen 0 400,00 432,00 466,56 503,88 544,20 587,73 634,75
10.000
8.000
6.000
4.000
2.000
0
1998 1999 2000 2001 2002 2003 2004 2005 2006

e
1
2
3
4
5
6
7
8
9
10
A B C D E F G H I
1999 2000 2001 2002 2003 2004 2005 2006
Kapital 5.000,00 5.400,00 5.832,00 6.298,56 6.802,44 7.346,64 7.934,37 8.569,12
Zinsen 0 400,00 432,00 466,56 503,88 544,20 587,73 634,75
10.000
8.000
6.000
4.000
2.000
0
1998 1999 2000 2001 2002 2003 2004 2005 2006

+
+

+
+

+
+

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
A B C D E F G H I J K L M N O P Q
1,56 2,05 1,76 1,68 1,86 1,71 1,62 1,78 1,76 1,83
1,74 1,69 1,91 1,89 1,81 1,93 1,72 1,78 1,73 1,83
4,00
VDF VF
1,20
UG OG Δ i h i f i d i F i
1,50 1,65 0,15 2 0,1 0,667 0,1
1,65 1,75 0,1 6 0,3 3,000 0,4
1,75 1,85 0,1 7 0,35 3,500 0,75
1,85 1,95 0,1 4 0,2 2,000 0,95
1,95 2,10 0,15 1 0,05 0,333 1
Matrixformel Spalte D:
{HÄUFIGKEIT($A$1:$J$2;$B$5:$B$9)}
1,30 1,50 1,65 1,75 1,85 1,95 2,10 2,25
VF 0,00 0,00 0,10 0,40 0,75 0,95 1,00 1,00
0,00
0,00
1,40 1,60 1,80 2,00 2,20
1,50 1,50 1,65 1,65 1,65 1,75 1,75 1,75 1,85 1,85 1,85 1,95 1,95 1,95 2,10 2,10
VDF 0,00 0,67 0,67 0,00 3,00 3,00 0,00 3,50 3,50 0,00 2,00 2,00 0,00 0,33 0,33 0,00
3,00
2,00
1,00
Größe in [m]
hi
+ + ←↪
n
fi = hi/n
Fi
i
F0 = f0,
Fi = fi + Fi−1, i = 1 k.
Fk = 1
Fi OGi F0
UG1 k + 1 (UG1, F0) (OG1, F1)
(OGk, Fk)
1,00
0,80
0,60
0,40
0,20

∆i
fi
di = fi
∆i
di fi
∆i
G = − (x − 3) 2 − (y − 2) 2 + 5
x + y ≥ 3
x 2 + y 2 ≤ 9
x, y ≥ 0

x y
x, y ≥ 0
¢ ¢
¢ ¢

x = 9/ √ 13
y = 6/ √ 13
3,5
3
2,5
2
1,5
1
0,5
0
0 1 2 3 4

y = sin(x) z = cos(x) [−4, 4]
y = sin(πx)/(πx) [−6, 6]
x = 0 1
G = x + 3y x · y ≤ 4 x 2 · y ≤ 16 2x −
2y ≤ 7 −2x + 2y ≤ −3 x, y ≥ 0
(x, y)
x + y ≥ 250
(100, 100)
1
2
3
4
5
6
7
8
9
10
11
12
13
A B C D E F G H I
Zahl
der
Flüge
Flug-
Flug
platz x Flughäfen Kilometer
A 40 200 40 4019,9502
B 160 210 10 1702,9386
C 250 160 20 4560,7017
D 220 80 30 5731,492
E 100 40 20 1843,9089
F 50 120 10 282,84271
Optimum 30 100
Min z =
u. d. Nebenbedingungen
18141,834
x + y ≤ 250 130
(x - 100)^2 + (y - 100)^2 ≥ 400 4900
250
200
150
100
50
0
Y
Standorte der Flughäfen
0 50 100 150 200
X
250
Flughäfen Optimum

X µ =
1, 80 σ = 0, 07
x ↦→ f(x) =
0, 5x 4 − 2x − 3 xp xn
x0 > xp
x0 = 3
[−2, 3]
xn
x ↦→ f(x) = x 4 /4 − 5/4x 2 + 1 [−3, 3]

X µ =
1, 80 σ = 0, 07
x ↦→ f(x) =
0, 5x 4 − 2x − 3 xp xn
x0 > xp
x0 = 3
[−2, 3]
xn
x ↦→ f(x) = x 4 /4 − 5/4x 2 + 1 [−3, 3]

X µ =
1, 80 σ = 0, 07
x ↦→ f(x) =
0, 5x 4 − 2x − 3 xp xn
x0 > xp
x0 = 3
[−2, 3]
xn
x ↦→ f(x) = x 4 /4 − 5/4x 2 + 1 [−3, 3]

•
•

\

+
+
+

⇑ +
⇑ +

Sub
End Sub

Sub IrgendeinName()
End Sub
Sub NeuesBlatt() Sub NeuesBlatt
’ Löschen der dritten Tabelle
Sub Tabelle3Weg()
Sheets(3).Select
ActiveSheet.Delete
End Sub
’ Neuerstellung der dritten Tabelle
Sub Tabelle3Her()
Sheets.Add
ActiveSheet.Name = "Tabelle3"
Sheets("Tabelle3").Move After:=Sheets(Sheets.Count)
End Sub
Tabelle3Weg()
Tabelle3Her()
Add Sheets
ActiveSheet
Sheets("Tabelle3").Select
HalloA1()
Save_As()

+
Tabelle3Weg() Tabelle3Her()
Tabelle3Her()

Sub ZellenKopie()
Sheets(1).Range("A1").Value = Sheets(3).Range("C1").Value
End Sub
Function Addi(ByVal a As Double, ByVal b As Double) As Double
Addi = a + b
End Function

Sub Function
a b

Sub AddierenUndKopieren()
Sheets(3).Range("C1").Value = _
Addi(Sheets(3).Range("A1").Value, _
Sheets(3).Range("B1").Value)
ZellenKopie
End Sub
Sub Gustav()

Dim Wert As Integer
Wert = MsgBox("Das aktive Arbeitsblatt Gustav nennen?", _
vbYesNo + vbQuestion, "Entscheidung!")
If (Wert = vbNo) Then Exit Sub
ActiveSheet.Name = "Gustav"
End Sub
Wert
Wert vbNo
Rueck = MsgBox( Meldung, Btns, Titel)

Sub MeldungsTest()
Sheets(1).Range("A1").Value = _
MsgBox("Mein Häuslein brennt!", _
VbOKCancel + VbExclamation, "Hilfe")
End Sub
Sub EiGudeWie()
MsgBox "Wir wünschen Ihnen einen guten Tag!"
End Sub
String
Sub FaerbeA1()
Dim Farbe As String
Farbe = InputBox("Wählen Sie rot oder gelb:",_
"Farbe eingeben", "rot)
Sheets(1).Select
Range("A1").Select
If (UCase(Farbe) = "ROT") Then _
Selection.Interior.ColorIndex = 3
If (UCase("Farbe") = "GELB") Then _
Selection.Interior.ColorIndex = 36
End Function

UCase()
DisplayAlerts()
1
2
A B C D E
Schaltflächen Symbol Meldung
Lieben Sie große Hunde
Titel Rückgabe
OK und Abbrechen Fragezeichen und kleine Kinder? Neugierig
Meldung()

Hans hans
Hans

Public Private Dim
Long Double
Dim alt As Long
Dim alpha As Double
alt Long
alpha Double
Dim
alt
alpha String
""
Variant
Dim Private Public
Dim alt As Long, neu As Long ’So ist es richtig!
Dim alpha, beta As Double ’So ist es falsch
Long
Double
beta alpha alpha Variant
Option Explicit
Dim
Private Public ReDim Static
Option Explicit

Dim alt As Long : alt = 30
Dim alt As Long
alt = 30
_
Sub Function If
Function End Function If End If
+ − ∗
If
Sub

Xxx12
xXX12 Xxx12
_xyz
92X -X ?XY _
X_08_15
Dim x As Long
Function Summe()
If
Hans hans
Hans
’

2500 = 1000 + 30 · 50
Option Explicit
Muss am Anfang stehen!
Public Grundgehalt As Double
Private Zuwachs As Double
Public Const Zulage = 50
Function Lohn(ByVal Alter As Long) As Double
Lohn = (Grundgehalt + Zulage * Alter) * (1 + Zuwachs)
End Function
Sub InitDaten()
Grundgehalt = 1000 ’Darf jeder wissen!
Zuwachs = 0,1 ’Chefsache!
End Sub
Private Sub LohnTest()
’ Zwei Anweisungen in einer Zeile! Brrrr!
Dim alt As Long : alt = 30
MsgBox "Lohn(30): " & Lohn(30)
InitDaten
alt = InputBox("Wie alt sind Sie?", "Alter eingeben", alt)
MsgBox "Sie sind " & alt & " Jahre alt und verdienen " _
& Lohn(alt) & " Euros!"
End Sub
LohnTest

Option Explicit
InitDaten MsgBox
Lohn InputBox
InitDaten()
LohnTest()
Option Explicit
Dim alt As Long: alt = 30
Lohn()
ByVal
Lohn()

Public
Private
[Public][Private] Variablenname [As Typ]
Public
Option Private Module
Private
Private Dim
Private
Dim
Private Public
Grundgehalt Zuwachs
Grundgehalt
alt LohnTest()

Option Explicit
Sub Sub1()
Dim lok As Long
lok = 2
MsgBox "Hier Sub1! lok = " & lok
End Sub
Sub Sub2()
Dim lok As Long
lok = 3
Sub1
MsgBox "Hier Sub2! lok = " & lok
End Sub
Sub1
Sub2 Sub1
Sub1
lok
lok Sub2
Option Explicit
Public pub As Long
Sub InitPub()
pub = 1
End Sub

Sub Pub1()
InitPub
MsgBox "Hier Pub1! pub = " & pub
End Sub
Sub Pub2()
Dim pub As Long
pub = 3
InitPub
MsgBox "Hier Pub2! pub = " & pub
MsgBox "Hier Pub2! GlobLoc.pub = " & GlobLoc.pub
End Sub
InitPub pub
pub pub
GlobLoc GlobLoc.pub
Const
Public Private
Public
[Public][Private] Const Bezeichner [As Typ] = Ausdruck
Private Const KurzPi = 3.14
Public Const LangPi As Double = KurzPi + 0.00159
Public Const GebDatum = "19.1.1971"

LangPi
GebDatum LangPi KurzPi
Zulage
Public
Public
Sub Function
Private
LohnTest()
Option Explicit
Sub Ausgabe()
InitDaten
MsgBox "Grundgehalt: " & Grundgehalt _
& vbNewLine & "Lohn im Alter 30: " & Lohn(30)
’Nicht erlaubt in einem anderen Modul
’MsgBox "Zuwachs = " & Zuwachs
’LohnTest
End Sub
InitDaten() Grundgehalt
Zuwachs
LohnTest()
Zuwachs Public
LohnTest() Private Public
Double

Byte
Integer
Long
Single
Double
Currency
Decimal ±79.228.162.514.264.337.593.543.950.335

±10
±0, 0000000000000000000000000001
Long Double
Sub UeberlaufTest()
Dim a As Integer, b As Integer
a = 16000
b = 17000
MsgBox "a + b = " & a + b
End Sub
Long Integer
Boolean
True False
Dim b As Boolean
b = i > 2
b True i
False
True False
True False
Dim i as Long
Dim b as Boolean
i = (i < 2) + 2*b

i b False
(i < 2) True 2*b
b False
True i
True False
If (Bedingung) Then Anweisung
If (Monat >= 11) Then MsgBox("Bald kommt der Nikolaus!")
If (Nachname = "Kohl") Then Vorname = "Helmut"
d = c*(a + b)
c d = (a + b)

+ − ∗ / ^
\ Mod
\ Mod
x*5^4, (y/x)^(-0.5), (x+y)/(x^2-z)
5x^4, (y/x)^-0.5, (xy)/(x^2-z) -2,3
\
Mod 17 Mod 4 16 Mod 4 22 Mod 4
17 \ 4 25 \ 5
x < y
x y
3 < 4
"drei"< "vier" True
False
x > y x < y
x >= y x

And
Or
X Y
True
True Xor
X Y Eqv
True
Imp X Imp Y True
X True Y = False
Not
If(a = 3 And c 5) Then Anweisung
If(a < 6 Or x > 4) Then Anweisung
If(Not(a < 6 Or x > 4)) Then Anweisung
x
a b
If(x > a And x < b) Then Anweisung
If(b > x > a) Then Anweisung
X Y

∗ /
+ −
< >=
=
=
2*3 + 4*5

a + b < c*d
(a + b) < (c*d)
Variable = Arithmetischer Ausdruck
gamma = 2*beta + alpha+5.004
a = 3*a + 2
gamma gamma
a a =
−1
a a
a a
a = b = 3*d + 1
a b 3*d + 1
a = (b = 3*d + 1)
b
3*d + 1 b a

Option Explicit
Public a As Double
Private Sub Set_a()
a = 1
End Sub
Sub Arith()
Dim i As Long
Dim a As Double
a = 2.1
Set_a
i = (a * a) ^ 2
a = a * a ^ 2
MsgBox "i = " & i & ", a = " & a & ", a = " & Abschluss.a
i = (i \ 4) * 4
MsgBox "i = " & i & ", i Mod 4 = " & i Mod 4
End Sub
1 − x 2 /2! + x 4 /4! x y−z
a n−1/2 /b 2n
-a = 4
4 = Hans
a - 2 = b + 4
"Hugo" = "Emma"
Test
Option Explicit
Public pub As Long
Sub Init(ByVal ww As Long)
pub = ww
End Sub
Function AddPub(ByVal d As Long)

AddPub = d + pub
End Function
Function NewAddPub(ByVal d As Long)
Dim pub As Long
NewAddPub = d + pub
Init 3
End Function
Sub Test()
Dim a As Long, b As Long
Dim c As Long, d As Long
a = 3
Init 1
b = AddPub(a)
c = NewAddPub(a)
d = AddPub(a)
MsgBox "b = " & b & ", c = " & c & ", d = " & d
End Sub
Sub BoolTest1()
Dim a As Long, b As Long, c As Long
c = a = b
MsgBox "c = " & c
c = Not c
MsgBox "c = " & c
End Sub
Sub BoolTest2()
Dim i As Long
Dim b As Boolean
i = (i = b) + 2 * True
MsgBox "i = " & i
End Sub

\ Mod
a a i
Long (a * a)^2
a = a * a^2 a = a * (a ^ 2)
(i \ 4)
i
i Mod 4

sin(3.14)
sin(2.1)
x
sin(x) tan(x)
WorksheetFunction
WorksheetFunction.Max(1,3,4)
WorksheetFunction.

Gehalt()
Option Explicit
Function Gehalt(ByVal al As Long, ByVal k As Long) As Long
Dim Grundgehalt As Long
Grundgehalt = 500
If (al > 30 And al < 46) Then Grundgehalt = 1000
If (al >= 46) Then Grundgehalt = 1500
Gehalt = Grundgehalt + k * 300
End Function
al k
500 + 300 = 800
1000 + 900 = 1900
1500 + 1200 = 2700
Function Name_der_Funktion(Parameterliste) As Typ_der_Funktion
Anweisungen
End Function
Function

ByVal
As
Gehalt
Gehalt
Long
Gehalt()
Gehalt = Grundgehalt + k*300
Gehalt
Gehalt
Gehalt(30,2)
Gehalt()
Dim s As Long
s = Gehal(20, 3) ’falscher Namen, Gehal statt Gehalt
s = Gehalt("Pi", 3.14) ’unsinnige Parametertypen
s = Gehalt(20, 3, 12) ’zu viele Parameter
Gehalt()
Sub GehaltTest()
Dim a As Long, k As Long
a = 48: k = 3
MsgBox "Alter: " & a & ", Kinder: " & k & _

", Gehalt: " & Gehalt(a, k)
MsgBox "Alter: 35" & ", Kinder: 2" & _
", Gehalt: " & Gehalt(35, 2)
End Sub
s = Gehalt(20, 3)
Gehalt(al, k) al k
Gehalt(20, 3)
al k
al k alter kinder
ByVal

ByRef
Sub Tausch(ByRef i As Long, ByRef j As Long)
Dim h As Long
h = j : j = i : i = h
End Sub
Tausch()
TauschtNicht()
Sub TauschtNicht(ByVal i As Long, ByVal j As Long)
Dim h As Long
h = j : j = i : i = h
End Sub
a b
c d
Sub TauschTest()
Dim a As Long, b As Long, c As Long, d As Long
a = 1: b = 2: c = 3: d = 4

Tausch a, b
TauschtNicht c, d
MsgBox "a = " & a & ", b = " & b & _
", c = " & c & ", d = " & d
End Sub
a = 2, b = 1, c = 3, d = 4
Tausch 10, 20
Exit Sub Exit Function
K0 p n Kn =
K0(1 + p/100) n
Function EndKapital(ByVal K_0 As Double, _
ByVal p As Double, ByVal n As Long) As Double
If (p < 0) Or (n < 0) Then Exit Function
EndKapital = WorksheetFunction.Round(K_0 * (1 + p/100) ^ n,2)
End Function
WorksheetFunction.Round

x 2 + px + q = 0.
D = p 2 − 4q
x1 = 0, 5(−p + D 0,5 ), x2 = 0, 5(−p − D 0,5 ).
p q
D x1 x2
Sub PQFormel(ByVal p As Double, q As Double, _
ByRef D As Double, ByRef x1 As Double, ByRef x2 As Double)
D = p ^ 2 - 4 * q
If (D < 0) Then Exit Sub
x1 = 0.5 * (-p + D ^ (0.5))
x2 = 0.5 * (-p - D ^ (0.5))
End Sub
Sub TestPQ()
Dim p As Double, q As Double
Dim D As Double, x As Double, y As Double
p = -9: q = 20
PQFormel -9, 20, D, x, y
MsgBox "D = " & D & ", x = " & x & ", y = " & y
End Sub
TestPQ
p = -9 q = 20
PQFormel
p q
p q
p PQFormel
p TestPQ
PQFormel
D D TestPQ
x y x1 x2 D
x y TestPQ PQFormel
p q TestPQ

n
n − 1
QS(1234) = QS(123) + 4 = 10 n
n! n
n! = n ∗ (n − 1)!
FakulRek Fakultät
n
Long Double
Function FakuRek(ByVal n As Integer) As Double
If (n < 0) Then FakuRek = 0
If (n = 0 Or n = 1) Then FakuRek = 1
If (n > 1) Then FakuRek = n * FakuRek(n - 1) ’(*)
End Function
n = 1
FakuRek = n * FakuRek(n - 1)
n = 1

n
n

ByRef
ByRef PQFormel
Zinssatz1
Exit Function
ax + by = e
cx + dy = f.
Det2 = ad − bc
x = (de − bf)/Det2 y = (af − ce)/Det2
Det2
Log(x)
Log_10(x) x

ISTSCHALTJAHR
True
False
QuersummeRek(n)

"Hallo"
2 31
2 16
String String*k

Sub StringTest()
Dim SVar As String
Dim SFest As String * 5
SVar = "Angela"
SFest = "Angela"
MsgBox "SVar = " & vbTab & SVar & vbNewLine & _
"SFest = " & vbTab & SFest
End Sub
SVar SFest
SVar = Angela
SFest = Angel
&

Sub TestEt()
Dim s As String, t As String, j As Long
s = "Hallo"
t = " Welt im Jahr " ’Leerzeichen beachten!
j = 2009
t = s & t & j & "!"
MsgBox t
End Sub
t "Hallo Welt im Jahr 2009!"
&
s = "Blah, blah, blah, blah, blah, blah, blah, blah, blah,"
s = s & " Dacapo: blah"
s = "Pi ist ungefähr " & 3.14
s "Pi ist ungefähr 3.14"
Len(s) s
LCase(s)
s
UCase(s)
s
Left(s, k) s k
s k
Right(s, k) s k
s k
Mid(s, i, k) s i k
s i
(i + k - 1) i k
Mid(s, i, k)
k

i Mid(s, i, 1)
i
String
InStr(pos, s, teilstr)
s teilstr pos
teilstr s
LTrim(s) RTrim(s) Trim(s)
Replace(s, findme, rplc)
s findme rplc
String
Variant String
Left$(s, k)
Left(s, k)
Sub StringFunctionTest()
Dim s As String, anf As String
Dim mitte As String, ende As String
Dim Us As String, Ls As String
s = " Hello World "
s = LTrim(s)
s = RTrim(s)
’Oder kurz s = Trim(s)
Us = UCase(s)
Ls = LCase(s)
MsgBox "s = " & s & ", Us = " & Us & ", Ls = " & Ls
anf = Left(s, 3)
ende = Right(s, 2)
mitte = Mid(s, 7, 2)
MsgBox "anf = " & anf & ", ende = " & ende _
& ", mitte = " & mitte
Mid(s, 7, 4) = "Welt"

Mid(s, 2, 1) = "a"
s = Left(s, Len(s) - 1)
MsgBox "s = " & s
End Sub
LTrim RTrim
InStr Replace
Sub ReplaceAndInStrTest()
Dim aus As String
Dim i As Long, j As Long
Dim s As String, sRplc As String
s = "Blah, sonst , Blah"
i = InStr(s, "Blah")
j = InStr(2, s, "Blah")
MsgBox "i = " & i & ", j = " & j
sRplc = Replace(s, "Blah", "XXX", 1)
MsgBox s & ", " & sRplc
End Sub
"21"
CInt(Ausdruck)
CLng(Ausdruck)
CSng(Ausdruck)
CDbl(Ausdruck)

CDec(Ausdruck)
CCur(Ausdruck)
CDate(Ausdruck)
CInt() CDbl()
IsNumeric() True
IsNumeric()
Long
Dim i As Long, istr As String
istr = InputBox("Alter", "Alter eingeben", 20)
If (IsNumeric(istr)) Then i = CLng(istr);
IsNumeric()
Double
Sub CDblTest()
Dim piKomma As String, piPunkt As String
Dim piRichtig As Double, piFalsch As Double
piKomma = "3,14"
If (IsNumeric(piKomma)) Then piRichtig = CDbl(piKomma)
MsgBox "Korrekte Umwandlung: " & piRichtig
piPunkt = "3.14"
If (IsNumeric(piPunkt)) Then piFalsch = CDbl(piPunkt)
MsgBox "Falsche Umwandlung: " & piFalsch
End Sub

Function KommaWeg(ByRef z As String) As String
Dim i As Long
i = InStr(z, ",")
If (i > 0) Then KommaWeg = Left(z, i - 1) & _
"." & Right(z, Len(z) - i)
End Function
Sub KommaWegSub(ByRef z As String)
z = KommaWeg(z)
End Sub
Sub KommaTest()
Dim pi As String, pipunkt As String
pi = "3,14"
pipunkt = KommaWeg("3,14")
KommaWegSub pi
’Aber nicht KommaWegSub(pi)
MsgBox "pi = " & pi & ", " & "pipunkt = " & pipunkt
End Sub
z String KommaWeg
KommaWegSub
KommaTest pi pipunkt

Date
Date #
#January 1, 1993# #1 Jan 93#
#mm/tt/yy#
#11/13/2009#
Date
Date
Date
Now Date
Variant
IsDate(d) Boolean
d
True
Date

True
#12/30/1899 12:00 am#
Day(d)
Month(d)
Year(d)
Hour(d)
Minute(d)
Second(d)
Weekday(datum, [firstdayofweek]))
vbMonday
DateSerial(jahr,monat,tag)
Date
DateSerial(2008,12,24)
TimeSerial(stu,m,sek) Date
DateAdd(interval,wieviel,datum)
Date
datum
interval
DateAdd("d",7,DateSerial(2008,12,24)
DateAdd("yyyy",7,DateSerial(2008,12,24)

Sub DateTest()
Dim Weihnacht As Date, Sylvester As Date, diff As Long
Dim aus As String, J As Long
J = Year(Now)
diff = DateSerial(J, 12, 24) - Now + Time
aus = "Now: " & Now & ", Time: " & Time
aus = aus & "." & vbNewLine & diff & "-mal werden wir noch"
aus = aus & " wach, heißa dann ist Weihnachtstach!"
MsgBox (aus)
End Sub
DateAdd
Sub DateAddTest()
Dim dt As Date
dt = DateSerial(2008, 12, 24)
MsgBox DateAdd("d", 7, dt) & ", " & DateAdd("yyyy", 7, dt) _
& ", " & DateAdd("m", -7, dt) & ", " & DateAdd("y", -7, dt)
End Sub
Public Function Muttertag(ByVal Jahr As Long) As Date
Muttertag = DateSerial(Jahr, 5, _
15 - Weekday(DateSerial(Jahr, 5, 1), vbMonday))
End Function
Public Function Ostersonntag(ByVal Jahr As Long) As Date
Dim a As Long, b As Long, C As Long
Dim D As Long, e As Long, f As Long

’ Die "magische" Gauss-Formel anwenden:
a = Jahr Mod 19
b = Jahr \ 100
C = (8 * b + 13) \ 25 - 2
D = b - (Jahr \ 400) - 2
e = (19 * (Jahr Mod 19) + ((15 - C + D) Mod 30)) Mod 30
If e = 28 And a > 10 Then e = 27
If e = 29 Then e = 28
f = (D + 6 * e + 2 * (Jahr Mod 4) _
+ 4 * (Jahr Mod 7) + 6) Mod 7
Ostersonntag = DateSerial(Jahr, 3, e + f + 22)
End Function
Function Pfingstsonntag(ByVal Jahr As Long)
Pfingstsonntag = DateAdd("d", 49, Ostersonntag(Jahr))
End Function
Function Fastnacht(ByVal Jahr As Long)
Fastnacht = DateAdd("d", -47, Ostersonntag(Jahr))
End Function
Person
Person
Nachname Vorname Geschlecht GebDat

NewPersW
Pers=NewPersW("Müller", "Lieschen") Pers.Nachname
Kopie = Pers
Kopie Pers
Vorname Kopie
Vorname Pers
PersonToString
Option Explicit
Public Type Person
Nachname As String
Vorname As String
Geschlecht As String * 1
GebDat As Date
End Type
Function NewPersW(ByRef n As String, ByRef vn As String) _
As Person
NewPersW.Nachname = n
NewPersW.Vorname = vn
NewPersW.Geschlecht = "W"
NewPersW.GebDat = Now() - Time()
End Function
Function PersonToString(ByRef p As Person) As String
PersonToString = p.Vorname & " " & p.Nachname & ", geb. " _
& p.GebDat
End Function
Sub TestPerson()
Dim Pers As Person, Kopie As Person
Pers = NewPersW("Müller", "Lieschen")
Kopie = Pers
Kopie.Vorname = "Helena"
MsgBox PersonToString(Pers) & ", " & PersonToString(Kopie)
End Sub
PersonToString

ToString
Variant
Dim IchBinVariant As Variant ’Explizit als Variant deklariert
Dim IchAuch ’Variablen ohne Typangabe sind Variant
Variant
Variant
Variant Long
Variant Long
Variant Byte Integer Long Single
Variant
Byte Integer Integer Long
Long Single Double
Currency Decimal Double
Variant
Long Double
Date
Double
String

a b
Long a = b
a
b a b
Long Double
MitHallo
HideLeftXX
SwitchIJ
i j

WegMitP
Alter
Frist
n
KMult
Invers(z) 1/z
InversSub(z) z 1/z
KomplexToString(z)

WegMitP
Alter
Frist
n
KMult
Invers(z) 1/z
InversSub(z) z 1/z
KomplexToString(z)

Sub IfTest()
Dim x As Double
x = InputBox("Bitte positive Zahl eingeben: ", "Los", "0")
If (x

If (x

Basiswert = 20
End If
’Hier geht’s weiter!
Gehalt = Grundgehalt + Alter*Basiswert
End Function
Alter
Else
End If
Else
End If
Function Brutto1(ByVal al As Long, ByVal k As Long) As Long
Dim Kindergeld As Long, Grundgehalt As Long
If (al < 15 Or k < 0) Then
Brutto1 = -1
k = 0
Else
If (al < 31) Then
Grundgehalt = 500
Kindergeld = 300
Else
If (al > 30 And al < 46) Then
Grundgehalt = 1000
Kindergeld = 250
Else
Grundgehalt = 1500

Kindergeld = 200
End If
End If
End If
Brutto1 = Grundgehalt + k*Kindergeld
End Function
Else If
If(Bedingung_1) Then
Anweisung(en)
ElseIf(Bedingung_2) Then
Anweisung(en)
’usw.
Else
Anweisung(en)
End If
If Else
End If
Brutto2()
Function Brutto2(ByVal al As Long, ByVal k As Long) As Long
Dim Kindergeld As Long, Grundgehalt As Long

If (al < 15 or k < 0) Then
Brutto2 = -1
k = 0
ElseIf (al < 31) Then
Grundgehalt = 500
Kindergeld = 300
ElseIf (al < 46) Then
Grundgehalt = 1000
Kindergeld = 250
Else
Grundgehalt = 1500
Kindergeld = 200
End If
Brutto2 = Grundgehalt + k*kindergeld
End Function
Case Select Case
Select Case(Ausdruck)
Case Auswahlliste1
Anweisung(en)
Case Auswahlliste2
Anweisung(en)
’usw.
Case Else
Anweisung(en)
End Select
Case Else
Function Brutto3(ByVal al As Long, ByVal k As Long) As Long
Dim Kindergeld As Long, Grundgehalt As Long

If ( k < 0) Then al = 0
Select Case al
Case Is < 15
Brutto3 = -1
k = 0
Case 15 To 30
Grundgehalt = 500
Kindergeld = 300
Case 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, _
42, 43, 44, 45
Grundgehalt = 1000
Kindergeld = 250
Case Else
Grundgehalt = 1500
Kindergeld = 200
End Select
Brutto3 = Grundgehalt + k * Kindergeld
End Function
Function Jahreszeit(ByVal tag As Long, _
ByVal mon As Long) As String
If (mon = 1 Or mon = 2 Or (mon = 3 And tag < 21) _
Or (mon = 12 And tag > 20)) Then
Jahreszeit = "Winter"
ElseIf (mon = 4 Or mon = 5 Or (mon = 3 And tag > 20) _
Or (mon = 6 And tag < 21)) Then
Jahreszeit = "Lenz"
ElseIf (mon = 7 Or mon = 8 Or (mon = 9 And tag < 21) _
Or (mon = 6 And tag > 20)) Then
Jahreszeit = "Sommer"

Else
Jahreszeit = "Herbst"
End If
End Function
Season()
Function Season(ByVal tag As Long, _
ByVal mon As Long) As String
Select Case mon
Case 1, 2, 3
Season = "Winter"
If (mon = 3 And tag > 20) Then Season = "Frühling"
Case 4 To 6
Season = "Frühling"
If (mon = 6 And tag > 20) Then Season = "Sommer"
Case Is 20) Then Season = "Herbst"
Case Else
Season = "Herbst"
If (mon = 12 And tag > 20) Then Season = "Winter"
End Select
End Function
Gehalt Bruttoi
Sub AuswahlTest()
Dim alt As Long, ki As Long
Dim t As Long, m As Long

alt = InputBox("Alter: ", "Los!", "30")
ki = InputBox("Anzahl Kinder: ", "Los!", "2")
MsgBox Gehalt(alt) & ", " & Brutto1(alt, ki)
MsgBox Brutto2(alt, ki) & ", " & Brutto3(alt, ki)
t = InputBox("Tag: ", "Los!", "13")
m = InputBox("Monat: ", "Los!", "11")
MsgBox Jahreszeit(t, m) & ", " & Season(t, m)
End Sub
•
•
•
Dim i As Long
For i = Anfangswert To Endwert [ Step Schritt ]
Anweisung(en)
[ Exit For ]
Anweisung(en)
Next i
i Anfangswert
Schritt
Schritt
Endwert
Exit For

1 n
n
i = n(n + 1)/2,
i=1
100
i=1
i = 100 · 101/2 = 5050.
Function MeineSumme(ByVal n As Long) As Long
Dim i As Long
MeineSumme = 0
For i = 1 To n
MeineSumme = MeineSumme + i
Next i
End Function
Function KillSz(ByRef s As String) As String
Dim i As Long
KillSz = ""
For i = 1 To Len(s)
If Mid(s, i, 1) = "ß" Then
KillSz = KillSz & "ss"
Else
KillSz = KillSz & Mid(s, i, 1)
End If
Next i
End Function
i
Function WegMitUmlauten(ByRef S As String) As String
Dim i As Long

WegMitUmlauten = ""
For i = 1 To Len(S)
Select Case Mid(S, i, 1)
Case "Ä": WegMitUmlauten = WegMitUmlauten & "Ae"
Case "ä": WegMitUmlauten = WegMitUmlauten & "ae"
Case "Ö": WegMitUmlauten = WegMitUmlauten & "Oe"
Case "ö": WegMitUmlauten = WegMitUmlauten & "oe"
Case "Ü": WegMitUmlauten = WegMitUmlauten & "Ue"
Case "ü": WegMitUmlauten = WegMitUmlauten & "ue"
Case Else: WegMitUmlauten = WegMitUmlauten & Mid(S, i, 1)
End Select
Next i
End Function
Do Loop
While Until
While Until
Do
Loop
Do
Anweisung(en)
[Exit Do]
Anweisung(en)
Loop While(Wiederholungsbedingung)
nächste Anweisung
Do Loop While
•
•

•
•
• Exit Do
Dim Jahr As Long
Do
Jahr = CInt(InputBox("Bitte Geburtsjahr eingeben: ","1978"))
Loop While (1900 > Jahr Or Jahr > 1990)
Until
Do
Anweisung(en)
[Exit Do]
Anweisung(en
Loop Until(Abbruchbedingung))
Dim Jahr As Long
Do
Jahr = CInt(InputBox("Bitte Geburtsjahr eingeben: ","1978"))
Loop Until (1900

i j
Function Ggt(ByVal i As Long, ByVal j As Long) _
As Long
Dim h As Long
If (i < 1 Or j < 1) Then Ggt = -1
If j > i Then
h = i : i = j : j = h
End If
Do
i = i Mod j
h = i : i = j : j = h
Loop While (j > 0)
’oder Loop Until (j = 0)
Ggt = i
End Function
Do While (Wiederholungsbedingung)
Anweisung(en)
[Exit Do]
Anweisung(en
Loop
While (Wiederholungsbedingung)
Anweisung(en)

[Exit While]
Anweisung(en
Wend
Exit Do Exit While
While Until
Do Until (Abbruchbedingung)
Anweisung(en)
[Exit Do]
Anweisung(en
Loop
Function Zaehle(ByRef gesamt As String, _
ByRef teil As String) As Long
Dim i As Long
Zaehle = 0 : i = 1
Do While (InStr(i, gesamt, teil) > 0)
’oder
’Do Until (InStr(i, gesamt, teil)

a a
a / Mod
k a
k = a Mod 10
a = (a - a Mod 10)/10
a
Function Quersumme(ByVal a As Long) As Long
Quersumme = 0
If (a < 0) Then a = -a
Do While (a > 0)
’Oder: Do Until (a = 0)
Quersumme = Quersumme + a Mod 10
a = (a - a Mod 10) / 10
Loop
End Function
Sub SchleifenTest()
MsgBox "Summe der Zahlen von 1 bis 100: " & MeineSumme(100)
MsgBox "Aus Walroßfüße wird: " & KillSz("Walroßfüße")
MsgBox "Aus Ää Öö Üü wird: " & WegMitUmlauten("Ää Öö Üü")
MsgBox "Größter gemeinsamer Teiler von 96 und 54: " _
& Ggt(96, 54)
MsgBox "Quersumme von 1234567: " & Quersumme(1234567)
MsgBox Zaehle("Fischers Fritz fischt frische Fische", "sch")
End Sub

i n
2i − 1
*
***
*****
*******
’usw
n 2i − 1 i
vbNewLine
Halbtanne()
Function HalbTanne(ByVal n As Long) As String
Dim i, j As Long
HalbTanne = ""
For i = 1 To n
For j = 1 To 2 * i - 1
HalbTanne = HalbTanne & "*"
Next j
HalbTanne = HalbTanne & vbNewLine
Next i
End Function

Sub TestHalbTanne()
Dim i As Long
i = InputBox("Bitte Anzahl der Zeilen eingeben: ", "", "12")
MsgBox HalbTanne(i)
End Sub
Sub DreiSchleifen()
Dim x As Double, s As String, b As Boolean
Do Until (UCase(InputBox("Wollen sie wirklich? Ja/Nein ", _
"Tu’s nicht", "Nein")) = "NEIN")
Do
Do
s = InputBox("Positive Zahl eingeben: ", "", "0")
b = IsNumeric(s)
If (Not b) Then MsgBox "Das ist keine Zahl!"
Loop Until (b)
x = CDbl(s)
If x

GoTo Marke Marke
x
1/x
Beratung
Ende Eingabe
Sub GoToTest()
Dim x As Double, aus As String
Eingabe:
x = InputBox("Bitte Zahl 0 eingeben: ", "Tu’s!", "1")
If (x = 0) Then GoTo Beratung
MsgBox "x = " & x & ", 1/x = " & 1 / x
GoTo Ende
Beratung:
MsgBox "Die Zahl " & x & " ist nicht positiv!"
GoTo Eingabe
Ende:
aus = InputBox("Nochmal? Ja/Nein ", "Tu’s nicht", "Nein")
If UCase(aus) = "JA" Then GoTo Eingabe
End Sub

Exit
• Exit Do
Exit Do
• Exit For
Exit For
• Exit While
Exit While
Exit While
Exit While
• Exit Select
Exit Select
• Exit Function
Exit Function
• Exit Sub
Exit Sub
Randomize
Exit Sub
Exit Do Rnd()
demoNum

Sub exitStatementDemo()
Dim demoNum As Single, i As Long, j As Long
Randomize
Do
j = j + 1
For i = 1 To 10
demoNum = Int(Rnd() * 100)
Select Case demoNum
Case 7: Exit For
Case 29: Exit Do
Case 54
MsgBox "Exit Sub bei j: " & j & ", i = " & i
Exit Sub
End Select
Next i
Loop
MsgBox "Exit Do bei j: " & j & ",i = " & i
End Sub
On Error Resume Next
On Error GoTo Marke
Sub OnErrorTest()
Dim x As Double, aus As String
On Error GoTo Ende
x = InputBox("Bitte Zahl 0 eingeben: ", "Tu’s!", "1")
MsgBox "x = " & x & ", 1/x = " & 1 / x

Exit Sub
Ende:
aus = aus & "Sie begingen Fehler mit Nummer " & Err & "!"
aus = aus & vbNewLine & Error & "!"
MsgBox aus, vbCritical, "Aufpassen!"
End Sub
Err
Error

Function Schaltjahr(ByVal j As Long) As Long
Schaltjahr = 0
If (j Mod 400 = 0) Or (j Mod 4 = 0 And j Mod 100 0) _
Then Schaltjahr = 1
End Function
Schaltjahr
Function LaufendeNr(ByVal j As Long, ByVal m As Long, _
ByVal t As Long) As Long
If (m < 3) Then
LaufendeNr = (m - 1) * 31
ElseIf (m < 9) Then
LaufendeNr = (m - 1) * 30 + (m - 1) \ 2 + Schaltjahr(j) - 2
Else
LaufendeNr = 243 + Schaltjahr(j) + (m - 9) * 30 + (m - 9)\2
End If
LaufendeNr = LaufendeNr + t
End Function

m - 1
t
j
Function TageSeitGregor(ByVal j As Long, ByVal m As Long, _
ByVal t As Long) As Long
Dim i As Long
TageSeitGregor = LaufendeNr(j, m, t)
For i = 1582 To j - 1
TageSeitGregor = TageSeitGregor + 365 + Schaltjahr(i)
Next i
End Function
j
LaufendeNr()
i
j - 1 TageSeitGregor
TageSeitGregor(j, m, t)
TageSeitGregor(j, m, t) + 4) Mod 7
WTag(j, m, t)
TageSeitGregor(j, m, t)
Function WTag(ByVal j As Long, ByVal m As Long, _
ByVal t As Long) As String
Select Case (TageSeitGregor(j, m, t) + 4) Mod 7
Case 0: WTag = "Sonntag"
Case 1: WTag = "Montag"
Case 2: WTag = "Dienstag"
Case 3: WTag = "Mittwoch"
Case 4: WTag = "Donnerstag"
Case 5: WTag = "Freitag"
Case Else: WTag = "Samstag"

End Select
End Function
Case
Sub KalenderTest()
MsgBox WTag(1999, 11, 13) & ", der 13.11.1999 war der " _
& LaufendeNr(1999, 11, 13) & " Tag des Jahres, und der " _
& TageSeitGregor(1999, 11, 13) & " Tag seit dem 1.1.1582."
End Sub
OhneP()
Replace()
Tannenbaum(Byval N As Long)
N
*
***
*****
*******
*********
N = 5 N

MyHour(d) MyMinute(d)
MyHour(0) = 0
MyMinute(0) = 0 MyHour(1) = 24 MyMinute(1) = 0
d
Schaltjahr()
LaufendeNr() TageSeitGregor()
AnzTageNeu()
AnzTage()
Select Case If
ElseIf
True False
MyYear(d) MyMonth(d) MyDay(d)
d = 152623
d < 0
Month() Day()

•
•
•
•
low up
N = up-low+1 N
Public Private Dim
Option Explicit
Sub Feldtest()
Dim Von0bis10(10) As Double
Dim mx As Double, sigma As Double, i As Long
For i = LBound(Von0bis10) To UBound(Von0bis10)
Von0bis10(i) = i*i
Next i
mx = WorksheetFunction.Max(Von0bis10)
sigma = WorksheetFunction.StDevP(Von0bis10)
MsgBox "Max = " & mx & ", Standardabweichung = " & sigma
End Sub
Von0bis10

Max StDevP
WorksheetFunction.
LBound(Datenfeld) UBound(Datenfeld)
Public ErstesDrittel(1 To 12) As Long
Public ZweitesDrittel(13 To 24) As Long
Public DrittesDrittel(24 To 36) As Long
Option Base 1
n − 1 n n
Variant
WoTage
WoTage(1) WoTage(7) Option Base 1
Option Explicit
Option Base 1
Sub ArrayBsp()
Dim WoTage As Variant
WoTage = Array("Montag", "Dienstag", "Mittwoch", _
"Donnerstag", "Freitag", "Samstag", "Sonntag")

MsgBox "Herrlich, heut ist " & WoTage(7)
Worksheets(1).Range("A1:G1").Value = WoTage
Worksheets(1).Range("A3:A9").Value = _
WorksheetFunction.Transpose(WoTage)
Worksheets(1).Columns("A:G").AutoFit
End Sub
ByRef
Weiten
SetWeiten
[a, b]
Sub SetWeiten(ByRef w() As Double, _
ByVal a As Double, ByVal b As Double)
Dim i As Long
For i = LBound(w) To UBound(w)
w(i) = Round(a + (b - a) * Rnd(), 2)
Next i
End Sub
Max
MyMax
Function MyMax(ByRef u As Variant) As Variant
Dim i As Long
MyMax = u(LBound(u))
For i = LBound(u) + 1 To UBound(u, 1)
If (u(i) > MyMax) Then MyMax = u(i)
Next i
End Function
Variant

MMult SetWeiten
Double
Variant
Excel.Range
Variant
Sub Vec2RangeVert(ByRef rg As Excel.Range, ByRef U As Variant)
On Error Resume Next
rg.Resize(UBound(U) - LBound(U) + 1, 1).Value = _
WorksheetFunction.Transpose(U)
End Sub
Option Explicit
Option Base 1
Sub Prozedurentest()
Dim i As Long
Dim Weiten(10) As Double
SetWeiten Weiten, 4, 7
MsgBox "Max: " & MyMax(Weiten)
Vec2RangeVert Worksheets(1).Range("I1"), Weiten
Worksheets(1).Columns("I:I").NumberFormat = "0.00"
Worksheets(1).Columns("I:I").EntireColumn.AutoFit
End Sub
Weiten [4, 7]
Vec2RangeVert

Preserve
DynArrayZu
Option Explicit
Option Base 1
Dim Faecher() As String
Sub DynArrayneu(ByVal N As Long)
Dim i As Long
If (N > 0) Then ReDim Faecher(N)
For i = 1 To N
Faecher(i) = InputBox("Name des Fachs: ")
Next i
End Sub
Sub DynArrayZu(ByVal Nzu As Long)
Dim i As Long, N As Long
N = UBound(Faecher)
If (Nzu > 0 And N > 0) Then ReDim Preserve Faecher(N + Nzu)
For i = 1 To Nzu
Faecher(N + i) = InputBox("Name des Fachs: ", "", "")
Next i
End Sub
Function Ausgabe(ByRef u As Variant) As String
Dim i As Long
For i = LBound(u) To UBound(Faecher) - 1
Ausgabe = Ausgabe & u(i) & vbNewLine
Next i
Ausgabe = Ausgabe & u(i)
End Function
Sub DynarrayTest()
DynArrayneu (2)
DynArrayZu (1)
MsgBox Ausgabe(Faecher)
End Sub

Option Base 1
Double
Dim Mat(4 TO 8, 9) As Double
(8 − 4 + 1) · 10 Mat(4, 0)
Mat(8, 9)
LBound
UBound Long
k = 1, 2
Variant
Option Explicit
Option Base 1
Sub MatToRange()
Dim mat As Variant
Dim zanz As Long, sanz As Long
Dim i As Long, j As Long
ReDim mat(3, 4)
’Gib der Matrix Werte
For i = LBound(mat, 1) To UBound(mat, 1)
For j = LBound(mat, 2) To UBound(mat, 2)
mat(i, j) = "(" & i & ", " & j & ")"
Next j
Next i
zanz = UBound(mat, 1) - LBound(mat, 1) + 1
sanz = UBound(mat, 2) - LBound(mat, 2) + 1

Sheets(2).Range("A1").Resize(zanz, sanz).Value = mat ’(*)
End Sub
mat
zans sanz
LBound UBound
MatToRange
i
j
Variant
RangeToMat FromRange
Sub RangeToMat()
Dim FromRange As Variant
FromRange = Worksheets(2).Range("A1").CurrentRegion.Value
MsgBox LBound(FromRange, 1) & ", " & UBound(FromRange, 1) _
& ", " & LBound(FromRange, 2) & ", " & UBound(FromRange, 2)
End Sub
Variant
MatMax
SetHilbert n
n ai,j 1/(i+j−1)
a1,1 = 1 a2,3 = a3,2 = 1/4
Option Explicit
Option Base 1
Function MatMax(ByRef m() As Double) As Double
Dim i As Long, j As Long
MatMax = m(LBound(m, 1), LBound(m, 2))
For i = LBound(m, 1) To UBound(m, 1)
For j = LBound(m, 2) To UBound(m, 2)
If m(i, j) > MatMax Then MatMax = m(i, j)

Next j
Next i
End Function
Sub SetHilbert(ByRef H As Variant, ByVal n As Long)
ReDim H(n, n)
Dim i As Long, j As Long
For i = 1 To n
For j = 1 To n
H(i, j) = 1 / (i + j - 1)
Next j
Next i
End Sub
Sub MatrixTest()
Dim mat() As Double
SetHilbert mat, 4
MsgBox MatMax(mat)
End Sub
MMult
MInv
Option Explicit
Option Base 1
Sub HilbertMatrix()
Dim i As Long, j As Long, n As Long
Dim mat As Variant, inv As Variant, idn As Variant
ReDim mat(1, 1)
n = 8
SetHilbert mat, n
MsgBox WorksheetFunction.MDeterm(mat)
Sheets(5).Range("A1:AZ200").Clear
inv = WorksheetFunction.MInverse(mat)

idn = WorksheetFunction.MMult(mat, inv)
Sheets(5).Cells(1, 1).Value = "Hilbert Matrix"
Sheets(5).Rows("2:" & CStr(n + 1)).NumberFormat="# ???/???"
Sheets(5).Cells(2, 1).Resize(n, n).Value = mat
Sheets(5).Cells(3 + n, 1).Value = "Inverse Hilbert Matrix"
Sheets(5).Cells(4 + n, 1).Resize(n, n).Value = inv
Sheets(5).Cells(5 + 2 * n, 1).Value = "Einheitsmatrix?"
Sheets(5).Cells(6 + 2 * n, 1).Resize(n, n).Value = idn
End Sub
Variant
MMult MInv
mat
Vec2String()
(v1, v2, . . . , vn)
v
MaxNorm()
v p ≥ 1
u
vp = |v(i)| p
i=l
1/p
,
l u
PNorm() p ≤ 0
−1 0 < p < 1
MaxDist()
v
v
σ 2
u
= v(i) 2
u
/n − v(i)
i=l
i=l
2
/n 2 ,

l u
Vec2String
1
2
3
4
5
6
A B C D E F G H I J
Dimension: 7 -1 2 3 4 -5 7 4
p: 2
MaxNorm: 7
P-Norm: 10,95445115
MaxDist: 12
Varianz: 13,14285714
Sub ErzeugeRndVec(ByVal n As Long, ByRef w() As Long)
n
Rnd()
[0, 1)
Auf Boolean Auf True
SwitchZ1Z2
Z1 Z2
Z1 Z2 Z1 Z2
× A = (aij)
aii
aij i ∈ {1, . . . , n}
n
|aij| < |aii|.
j=1
j=i
× A
A∞

A∞ = max
i=1,...,m
n
|aij|.
Komplex
j=1

•
•
•
•

•
•
•
•
•
•

CommandButton1_Click()
+

⇑ +
Caption
Caption

Label1 TextBox1 CommandButton1
Label2
⇑

UserForm1

Name
Name
TextBox TextBox1
TextBox2
Label
Label1 Label2
Userform Userform1 Userform2
Label1 TextBox1 CommandButton1
Userform1
Name Caption
Caption
UserForm1 Testformular
Value
Value True
False
Top Left Width Height
Width
Height Left Top
Left Top

ShowModal True
False
Caption
CmdBtn
CmdBtn.Enabled = False
CmdBtn.Caption = "Drücken zwecklos!"
Enabled True False
True
Caption
UserForm1
Label1 TextBox1 CommandButton1
Caption
ShowModal
False

CmdBtn.Move CmdBtn.Left + 10, CmdBtn.Top + 20
Move Left Top
Move
CommandButton1.
Move
Show Hide
Show
UserForm1.Show vbModal
UserForm2.Show vbModeless

UserForm3.Hide
Unload
Load
Load Initialize
UserForm_Initialize()
Load UserForm1
UserForm1.Show
UserForm1.Show

UserForm
Initialize
UserForm_Initialize
Value
Tabelle1
Click
Commandbutton1_Click
Tabelle1
Value TextBox1

Click Change
TextBox1 TextBox1_Change
TextBox1_Change
Commandbutton1_Click
Private Sub TextBox1_Change()
CommandButton1_Click
End Sub
Private Sub Objekt_Activate()
Private Sub Objekt_Deactivate()
Private Sub UserForm_Activate()
Private Sub UserForm_Deactivate()
Private Sub Tabelle1_Activate()
Private Sub Tabelle1_Deactivate()
•
•

•
•
Ausführen|Sub/UserForm ausführen
Activate Deactivate
Tabelle1
Worksheet
Activate
Worksheet
Worksheet_Activate
Show
Initialize
Hide
Initialize
Tabelle1
Worksheet
Activate
UserForm1

Tabelle1
Name
String Visible Boolean
Font

CommandButton TextBox
MSForms.CommandButton
Excel.Workbook
Long Double
Dim
Dim a as Long, b As Long
a = 1
b = a
a = a + 1
MsgBox "a = " & a & ", b = " & b
a = 1 a
a = b
a
Sub ChangeBtn()
1. Application.Wait (Now + TimeValue("0:00:03"))
2. Dim Btn As MSForms.CommandButton
3. Dim Btndoppel As MSForms.CommandButton
4. Set Btn = Userform1.CommandButton1
5. Set Btndoppel = Btn
6. Btn.Caption = "Submit"
7. Btn.Font.Name = "Courier New"
8. Btn.Font.Size = 12
9. Btn.Font.Italic = True
10. Userform1.CommandButton1.Font.Bold = True

11. Btndoppel.AutoSize = True
12. Btn.Move Btn.Left, Btn.Top - 4
End Sub
MSForms.CommandButton
MSForms.CommandButton
Btn
Set
Userform1.CommandButton1
Btn
a = b a b
Set a = b a
b

With
With Btn
.Caption = "Submit"
With .Font
.Name = "Courier New"
.Size = 12
.Italic = True
.Bold = True
End With
.AutoSize = True
.Move .Left, .Top - 4
End With
Btn
Tabelle3
New

MyUserform
Private
Set MyUserForm = New Userform1
Me
Unload MyUserform
Nothing
Set
Nothing
Set Btn = Nothing
Set
Nothing
Nothing
Set
Nothing

Nothing
If ( Btn Is Nothing ) Then MsgBox"Btn nicht verwendbar"
’Nicht: If ( Btn = Nothing ) Then MsgBox"Btn nicht verwendbar"
Is
Sub ChangeCaption()
Dim Btn As MsForms.CommandButton
If (Btn Is Nothing) Then MsgBox "Btn is Nothing"
Set Btn = UserForm1.CommandButton1
E: Btn.Caption = "Submit"
On Error GoTo Fehler
Set Btn = Nothing
F: Btn.AutoSize = True
Fehler: MsgBox Err.Description
End Sub
Btn Nothing

Nothing
If ( Btn Is Nothing ) Then MsgBox"Btn nicht verwendbar"
’Nicht: If ( Btn = Nothing ) Then MsgBox"Btn nicht verwendbar"
Is
Sub ChangeCaption()
Dim Btn As MsForms.CommandButton
If (Btn Is Nothing) Then MsgBox "Btn is Nothing"
Set Btn = UserForm1.CommandButton1
E: Btn.Caption = "Submit"
On Error GoTo Fehler
Set Btn = Nothing
F: Btn.AutoSize = True
Fehler: MsgBox Err.Description
End Sub
Btn Nothing

MitHallo
HideLeftXX
SwitchIJ
i j
WegMitP
Function MitHallo(ByRef z As String)
MitHallo = "Hallo " & z
End Function
Function HideLeftWithX(ByRef s As String) As String
HideLeftWithX = s
If Len(s) >= 2 Then _
HideLeftWithX = "XX" & Right(s, Len(s) - 2)
End Function
Function HideRightWithX(ByRef s As String) As String
HideRightWithX = s
If Len(s) >= 2 Then _
HideRightWithX = Left(s, Len(s) - 2) & "XX"
End Function

Function SwitchIJ(ByRef s As String, ByVal i As Long, _
ByVal j As Long) As String
SwitchIJ = s
If (i < 1 Or j < 1 Or i > Len(s) Or j > Len(s)) Then _
Exit Function
Mid(SwitchIJ, i, 1) = Mid(s, j, 1)
Mid(SwitchIJ, j, 1) = Mid(s, i, 1)
End Function
’Oder ohne Exit Function:
Function SwitchIJ(ByRef s As String, ByVal i As Long, _
ByVal j As Long) As String
SwitchIJ = s
If (i > 0 And i 0 And j

Frist = DateAdd("d", n, dat)
If (Weekday(Frist, vbMonday) = 6) Then _
Frist = DateAdd("d", n + 2, dat)
If (Weekday(Frist, vbMonday) = 7) Then _
Frist = DateAdd("d", n + 1, dat)
End Function
Public Function Sommerzeit(ByVal JahrA As Long) As Date
Sommerzeit = DateSerial(JahrA, 3, 31 - _
(Weekday(DateSerial(JahrA, 3, 31), vbMonday) Mod 7))
End Function
Public Function Winterzeit(ByVal JahrA As Long) As Date
Winterzeit = DateSerial(JahrA, 10, 31 - _
(Weekday(DateSerial(JahrA, 10, 31), vbMonday) Mod 7))
End Function
Public Function VierterAdvent(ByVal JahrA As Long) As Date
VierterAdvent = DateSerial(JahrA, 12, 25 - _
Weekday(DateSerial(JahrA, 12, 25), vbMonday))
End Function
KMult
Invers(z) 1/z
InversSub(z) z 1/z
KomplexToString(z)
Option Explicit
Public Type Komplex
Re As Double
Im As Double
End Type
Function KomplexToString(ByRef z As Komplex) As String
If (z.Re = 0 And z.Im = 0) Then
KomplexToString = "0"
ElseIf (z.Re = 0) Then
KomplexToString = z.Im & "i"
If (z.Im = 1) Then KomplexToString = "i"
If (z.Im = -1) Then KomplexToString = "-i"
Else
If (z.Im > 0) Then KomplexToString = _

z.Re & " + " & z.Im & "i"
If (z.Im < 0) Then KomplexToString = _
z.Re & " - " & (-z.Im) & "i"
If (z.Im = 1) Then KomplexToString = z.Re & " + i"
If (z.Im = -1) Then KomplexToString = z.Re & " - i"
If (z.Im = 0) Then KomplexToString = z.Re
End If
End Function
Function KMult(ByRef w As Komplex, ByRef z As Komplex) _
As Komplex
KMult.Re = w.Re * z.Re - w.Im * z.Im
KMult.Im = w.Re * z.Im + w.Im * z.Re
End Function
Function Invers(ByRef z As Komplex) As Komplex
If (z.Re = 0 And z.Im = 0) Then Exit Function
Dim betraghoch2 As Double
betraghoch2 = z.Re ^ 2 + z.Im ^ 2
Invers.Re = z.Re / betraghoch2
Invers.Im = -z.Im / betraghoch2
End Function
Function Netto1(ByVal Brutto As Long, _
ByVal k As Long, ByVal verh As Boolean) As Double
If (Brutto < 0) Then
Netto1 = 0
Else
Dim anz As Long
anz = k
If (verh = True) Then anz = anz + 1
If (anz = 0) Then

Netto1 = Brutto * 0.6
Else
If (anz = 1) Then
Netto1 = Brutto * 0.7
Else
Netto1 = Brutto * 0.8
End If
End If
End If
End Function
Function Netto2(ByVal Brutto As Long, _
ByVal k As Long, ByVal verh As Boolean) As Double
If (Brutto < 0) Then
Netto2 = 0
Exit Function ’Exit mögen manche nicht
End If
Dim anz As Long
anz = k
If (verh) Then anz = anz + 1
If (anz = 0) Then
Netto2 = Brutto * 0.6
ElseIf (anz = 1) Then
Netto2 = Brutto * 0.7
Else
Netto2 = Brutto * 0.8
End If
End Function
Function Netto3(ByVal Brutto As Double, _
ByVal k As Long, ByVal verh As Long) As Double
If (Brutto < 0) Then
Netto3 = 0
Else
Dim anz As Long ’ anz: Anzahl der Familienmitglieder
anz = k
If (verh 0) Then anz = anz + 1
Select Case anz
Case 0
Netto3 = Brutto * 0.6
Case 1

Netto3 = Brutto * 0.7
Case Else
Netto3 = Brutto * 0.8
End Select
End If
End Function
OhneP()
Replace()
Tannenbaum(Byval N As Long)
N
*
***
*****
*******
*********
N = 5 N
Function OhneP(ByRef s As String) As String
Dim i As Long
OhneP = s
For i = 1 To Len(s)
If Mid(OhneP, i, 1) = "P" Then Mid(OhneP, i, 1) = "B"
If Mid(OhneP, i, 1) = "p" Then Mid(OhneP, i, 1) = "b"
Next i
End Function
Function Tannenbaum(ByVal n As Integer) As String
Dim i As Long, k As Long
Tannenbaum = ""
For i = 1 To n
For k = 1 To n - i
Tannenbaum = Tannenbaum & " "
Next k
For k = 1 To 2 * i - 1
Tannenbaum = Tannenbaum & "*"
Next k
Tannenbaum = Tannenbaum & vbNewLine
Next i

End Function
Function ZaehleVokale(ByRef s As String) As Long
Dim i As Long, z As Long
z = 0
For i = 1 To Len(s)
Select Case UCase(Mid(s, i, 1))
Case "A", "E", "I", "O", "U": z = z + 1
End Select
Next i
ZaehleVokale = z
End Function
MyHour(d) MyMinute(d)
MyHour(0) = 0
MyMinute(0) = 0 MyHour(1) = 24 MyMinute(1) = 0
d
Function MyMinute(d As Double) As Long
If (d < 0 Or d > 1) Then MyMinute = -1
MyMinute = Fix(d * 24 * 60) Mod 60
End Function
Function MyHour(d As Double)
If (d < 0 Or d > 1) Then MyHour = -1
MyHour = Fix(24 * d)
End Function
Schaltjahr()
LaufendeNr() TageSeitGregor()
AnzTageNeu()
AnzTage()
Select Case If
ElseIf

True False
MyYear(d) MyMonth(d) MyDay(d)
d = 152623
d < 0
Function AnzTage(j As Long, m As Long) As Long
If (m < 1 Or m > 12) Then
AnzTage = -1
Else
Select Case m
Case 4, 6, 9, 11
AnzTage = 30
Case 2
AnzTage = 28 + Schaltjahr(j)
Case Else
AnzTage = 31
End Select
End If
End Function
Function DateCheck(j As Long, m As Long, d As Long) As Boolean
DateCheck = False
If (0 < d And d 12) Then
AnzTageNeu = -1
Else
AnzTageNeu = 30 + m Mod 2
If (m = 2) Then AnzTageNeu = 29 + Schaltjahr(j)
End If
End Function
Function MyYear(d As Long)
Dim y As Long, n As Long
Dim Schluss As Boolean
MyYear = 1582 + Fix(d / 365.2425)
Schluss = False
Do

If (d < TageSeitGregor(MyYear, 1, 1)) Then
MyYear = MyYear - 1
ElseIf (TageSeitGregor(MyYear, 12, 31) < d) Then
MyYear = MyYear + 1
Else
Schluss = True
End If
’*** Vermeidet Idiotenschleife!!!***
n = n + 1
Loop While (n < 100 And Schluss = False)
End Function
Function MyMonth(d As Long)
Dim y As Long, i As Long, l As Long, lni As Long
y = MyYear(d)
l = d - TageSeitGregor(y - 1, 12, 31)
i = 12
lni = LaufendeNr(y, i, 1)
Do While (l < lni And i > 1)
i = i - 1
If i > 1 Then lni = LaufendeNr(y, i, 1)
Loop
MyMonth = i
End Function
Function MyDay(d As Long)
Dim y As Long, i As Long, l As Long
y = MyYear(d)
i = MyMonth(d)
MyDay = d - TageSeitGregor(y, i, 1) + 1
End Function
Vec2String()
(v1, v2, . . . , vn)
v
MaxNorm()
v p ≥ 1
u
vp = |v(i)| p
i=l
1/p
,

l u
PNorm() p ≤ 0
−1 0 < p < 1
MaxDist()
v
v
σ 2
u
= v(i) 2
u
/n − v(i)
i=l
l u
i=l
2
/n 2 ,
Vec2String
1
2
3
4
5
6
Option Explicit
Option Base 1
A B C D E F G H I J
Dimension: 7 -1 2 3 4 -5 7 4
p: 2
MaxNorm: 7
P-Norm: 10,95445115
MaxDist: 12
Varianz: 13,14285714
Function Vec2String(ByRef v As Variant) As String
If Not IsArray(v) Then Exit Function
Dim i As Long
Vec2String = "("
For i = LBound(v) To UBound(v) - 1
Vec2String = Vec2String & v(i) & ", "
Next i
Vec2String = Vec2String & v(UBound(v)) & ")"
End Function

Function MaxNorm(ByRef v() As Double) As Double
Dim j As Long
MaxNorm = Abs(v(LBound(v)))
For j = LBound(v) + 1 To UBound(v)
If (Abs(v(j)) > MaxNorm) Then MaxNorm = Abs(v(j))
Next j
End Function
Function PNorm(ByRef u() As Double, _
ByVal p As Double) As Double
Dim i As Long, k As Long
If p < 1 Then
PNorm = -1
Else
k = LBound(u)
PNorm = Abs(u(k)) ^ p
For i = k + 1 To UBound(u)
PNorm = PNorm + Abs(u(i)) ^ p
Next i
PNorm = PNorm ^ (1 / p)
End If
End Function
Function MaxDist(ByRef v() As Double) As Double
Dim j As Long, max As Double, min As Double
max = min = v(LBound(v))
For j = LBound(v) + 1 To UBound(v)
If (v(j) > max) Then max = v(j)
If (v(j) < min) Then min = v(j)
Next j
MaxDist = max - min
End Function
Function VarianzVec(ByRef v() As Double) As Double
Dim i As Long, n As Long
Dim sqrs As Double, svar As Double
svar = 0
sqrs = 0
For i = LBound(v) To UBound(v)
svar = svar + v(i)
sqrs = sqrs + v(i) * v(i)

Next i
n = UBound(v) - LBound(v) + 1
VarianzVec = (sqrs - svar * svar / n) / n
End Function
Sub TestProzedur()
Dim v() As Double
Dim n As Long, i As Long, p As Double
Worksheets("Tabelle1").Select
n = Cells(1, 2).Value
p = Cells(2, 2).Value
ReDim v(n)
For i = 1 To n
v(i) = Cells(1, i + 3).Value
Next i
MsgBox "Der Vektor ist: " & Vec2String(v)
Cells(3, 2).Value = MaxNorm(v)
Cells(4, 2).Value = PNorm(v, p)
Cells(5, 2).Value = MaxDist(v)
Cells(6, 2).Value = VarianzVec(v)
End Sub
Sub ErzeugeRndVec(ByVal n As Long, ByRef w() As Long)
n
Rnd()
[0, 1)
Sub ErzeugeRndVec(ByVal n As Long, ByRef w() As Long)
Dim i As Long
Dim Ober As Long, Unter As Long
Ober = 6
Unter = 1
Randomize
ReDim w(n)
For i = 1 To n
w(i) = Int((Ober - Unter + 1) * Rnd() + Unter)
’Also: w(i) = Int(6 * Rnd() + 1)
Next i
End Sub

Auf Boolean Auf True
’ Quelle:
’ http://dbwiki.net/wiki/VBA_Tipp:_Bubblesort (31.1.2013)
’ Ganz leicht verändert
Public Function BubbleSortAsc(vArray As Variant) As Long
’
’ Ascending: aufsteigend sortieren
’
If Not IsArray(vArray) Then Exit Function
Dim Mark As Long, i As Long
Dim EndIdx As Long, StartIdx As Long
Dim Temp As Variant
Dim cnt As Long
cnt = 0
EndIdx = UBound(vArray)
StartIdx = LBound(vArray)
Do While EndIdx > StartIdx
Mark = StartIdx
For i = StartIdx To EndIdx - 1
Marke: If vArray(i) > vArray(i + 1) Then
Temp = vArray(i)
vArray(i) = vArray(i + 1)
vArray(i + 1) = Temp
Mark = i
cnt = cnt + 1
End If
Next i
EndIdx = Mark
Loop
BubbleSortAsc = cnt
End Function
’ Genauso Absteigend sortieren: In der markierten Anweisung
’ das Vorzeichen > durch < ersetzen
Public Function BubbleSortAsc(vArray As Variant) As Long
usw.
Function BubbleSort(ByRef vArray As Variant, _
ByVal Asc As Boolean)
If Asc Then
BubbleSort = BubbleSortAsc(vArray)
Else

BubbleSort = BubbleSortDsc(vArray)
End If
End Function
Sub Testbubble()
Dim anz As Long
anz = 80
Dim v As Variant
ReDim v(anz)
Dim aus As String
Dim i As Long
For i = 1 To anz
v(i) = Chr(Int(Rnd * (90 - 65 + 1) + 65))
Next i
’ Im Vektor befinden sich große Buchstaben von A bis Z
aus = "Unsortiert: " & vbTab & Vec2String(v) & vbNewLine
i = BubbleSort(v, True)
aus = aus & "Sortiert: " & vbTab & Vec2String(v)
MsgBox aus & " i = " & i
aus = "Unsortiert: " & vbTab & Vec2String(v) & vbNewLine
i = BubbleSort(v, False)
aus = aus & "Sortiert: " & vbTab & Vec2String(v)
MsgBox aus & " i = " & i
End Sub
SwitchZ1Z2
Z1 Z2
Z1 Z2 Z1 Z2
Sub SwitchZ1Z2(ByRef m As Variant, ByVal Z1 As Long,_
ByVal Z2 As Long)
If (Z1 < LBound(m, 1) Or Z1 > UBound(m, 1)) Then Exit Sub
If (Z2 < LBound(m, 1) Or Z2 > UBound(m, 1)) Then Exit Sub
Dim s As Long
Dim H As Variant
For s = LBound(m, 2) To UBound(m, 2)
H = m(Z1, s)
m(Z1, s) = m(Z2, s)
m(Z2, s) = H
Next s
End Sub

× A = (aij)
aii
aij i ∈ {1, . . . , n}
n
|aij| < |aii|.
Function IsDiagDom(ByRef m As Variant) As Boolean
IsDiagDom = True
Dim rows As Long, cols As Long
Dim rowidx, colidx As Long
j=1
j=i
Dim rowstart, rowend As Long
Dim colstart, colend As Long
rowstart = LBound(m, 1)
rowend = UBound(m, 1)
colstart = LBound(m, 2)
colend = UBound(m, 2)
rows = rowend - rowstart + 1
cols = colend - colstart + 1
If (rows cols) Then
IsDiagDom = False
Else
Dim sum As Double
Dim i As Long
Dim j As Long
i = LBound(m, 1)
Do While (IsDiagDom = True And i

Loop
End If
End Function
× A
A∞
A∞ = max
i=1,...,m
n
|aij|.
Komplex
Function ZSnorm(ByRef m As Variant) As Double
Dim i As Long
Dim j As Long
Dim help As Double
help = 0
ZSnorm = 0
For i = LBound(m, 1) To UBound(m, 1)
For j = LBound(m, 2) To UBound(m, 2)
help = help + Abs(m(i, j))
Next j
If ZSnorm < help Then ZSnorm = help
help = 0
Next i
End Function
j=1

Loop
End If
End Function
× A
A∞
A∞ = max
i=1,...,m
n
|aij|.
Komplex
Function ZSnorm(ByRef m As Variant) As Double
Dim i As Long
Dim j As Long
Dim help As Double
help = 0
ZSnorm = 0
For i = LBound(m, 1) To UBound(m, 1)
For j = LBound(m, 2) To UBound(m, 2)
help = help + Abs(m(i, j))
Next j
If ZSnorm < help Then ZSnorm = help
help = 0
Next i
End Function
j=1

Loop
End If
End Function
× A
A∞
A∞ = max
i=1,...,m
n
|aij|.
Komplex
Function ZSnorm(ByRef m As Variant) As Double
Dim i As Long
Dim j As Long
Dim help As Double
help = 0
ZSnorm = 0
For i = LBound(m, 1) To UBound(m, 1)
For j = LBound(m, 2) To UBound(m, 2)
help = help + Abs(m(i, j))
Next j
If ZSnorm < help Then ZSnorm = help
help = 0
Next i
End Function
j=1

Loop
End If
End Function
× A
A∞
A∞ = max
i=1,...,m
n
|aij|.
Komplex
Function ZSnorm(ByRef m As Variant) As Double
Dim i As Long
Dim j As Long
Dim help As Double
help = 0
ZSnorm = 0
For i = LBound(m, 1) To UBound(m, 1)
For j = LBound(m, 2) To UBound(m, 2)
help = help + Abs(m(i, j))
Next j
If ZSnorm < help Then ZSnorm = help
help = 0
Next i
End Function
j=1

Loop
End If
End Function
× A
A∞
A∞ = max
i=1,...,m
n
|aij|.
Komplex
Function ZSnorm(ByRef m As Variant) As Double
Dim i As Long
Dim j As Long
Dim help As Double
help = 0
ZSnorm = 0
For i = LBound(m, 1) To UBound(m, 1)
For j = LBound(m, 2) To UBound(m, 2)
help = help + Abs(m(i, j))
Next j
If ZSnorm < help Then ZSnorm = help
help = 0
Next i
End Function
j=1

Loop
End If
End Function
× A
A∞
A∞ = max
i=1,...,m
n
|aij|.
Komplex
Function ZSnorm(ByRef m As Variant) As Double
Dim i As Long
Dim j As Long
Dim help As Double
help = 0
ZSnorm = 0
For i = LBound(m, 1) To UBound(m, 1)
For j = LBound(m, 2) To UBound(m, 2)
help = help + Abs(m(i, j))
Next j
If ZSnorm < help Then ZSnorm = help
help = 0
Next i
End Function
j=1