Option
Explicit
Sub
Auswertung()
Application.ScreenUpdating =
False
Dim
p
As
Integer
Dim
st
As
Integer
Dim
s
As
Integer
Dim
e
As
Integer
Dim
w
As
Integer
Dim
Start
As
Date
Dim
Ende
As
Date
Dim
a1
As
Integer
Dim
a2
As
Integer
Dim
a3
As
Integer
Dim
a4
As
Integer
Dim
i
As
Integer
Dim
j
As
Integer
Dim
k
As
Integer
Dim
l
As
Integer
Dim
v1
As
Integer
Dim
v2
As
Integer
Dim
v3
As
Integer
Dim
v4
As
Integer
p = 4
st = 1
s = 9
e = 11
w = 3
ThisWorkbook.Worksheets(
"Industrie"
).Activate
Start = Worksheets(
"Industrie Auswertung"
).Range(
"C5"
).Value
Ende = Worksheets(
"Industrie Auswertung"
).Range(
"D5"
).Value
a1 = 0
v1 = 0
For
i = p
To
Cells(Rows.Count, st).
End
(xlUp).Row
If
Cells(i, s) >= Start
And
Cells(i, e) <= Ende
And
Cells(i, st) =
"Abgeschlossen"
Then
v1 = v1 + Cells(i, w).Value
a1 = a1 + 1
End
If
Next
a2 = 0
v2 = 0
For
j = p
To
Cells(Rows.Count, st).
End
(xlUp).Row
If
Cells(j, s) >= Start
And
Cells(j, e) <= Ende
And
Cells(j, st) =
"Laufend"
Then
v2 = v2 + Cells(j, w).Value
a2 = a2 + 1
End
If
Next
a3 = 0
v3 = 0
For
k = p
To
Cells(Rows.Count, st).
End
(xlUp).Row
If
Cells(k, s) >= Start
And
Cells(k, e) <= Ende
And
Cells(k, st) =
"Angebot"
Then
v3 = v3 + Cells(j, k).Value
a3 = a3 + 1
End
If
Next
a4 = 0
v4 = 0
For
l = p
To
Cells(Rows.Count, st).
End
(xlUp).Row
If
Cells(l, s) >= Start
And
Cells(l, e) <= Ende
And
Cells(l, st) =
"Abgelehnt"
Then
v4 = v4 + Cells(l, w).Value
a4 = a4 + 1
End
If
Next
Worksheets(
"Industrie Auswertung"
).Range(
"E5"
).Value =
"Abgeschlossen"
Worksheets(
"Industrie Auswertung"
).Range(
"E6"
).Value =
"Laufend"
Worksheets(
"Industrie Auswertung"
).Range(
"E7"
).Value =
"Angebot"
Worksheets(
"Industrie Auswertung"
).Range(
"E8"
).Value =
"Abgelehnt"
Worksheets(
"Industrie Auswertung"
).Range(
"F5"
).Value = a1
Worksheets(
"Industrie Auswertung"
).Range(
"F6"
).Value = a2
Worksheets(
"Industrie Auswertung"
).Range(
"F7"
).Value = a3
Worksheets(
"Industrie Auswertung"
).Range(
"F8"
).Value = a4
Worksheets(
"Industrie Auswertung"
).Range(
"G5"
).Value = v1
Worksheets(
"Industrie Auswertung"
).Range(
"G6"
).Value = v2
Worksheets(
"Industrie Auswertung"
).Range(
"G7"
).Value = v3
Worksheets(
"Industrie Auswertung"
).Range(
"G8"
).Value = v4
ThisWorkbook.Worksheets(
"Industrie Auswertung"
).Activate
Cells(1, 1).
Select
Application.ScreenUpdating =
True
End
Sub