Private
Sub
AufträgeQuartal()
Dim
AV, Quartale&(), MSG$
Dim
R&, I%, E&, LR&
ReDim
Quartale(1
To
4)
With
ActiveSheet
LR = .Cells(1, 2).
End
(xlDown).Row
AV = .Range(.Cells(1, 2), .Cells(LR, 2)).Value
End
With
E = UBound(AV)
For
R = 1
To
E
I = Quartal(AV(R, 1))
Quartale(I) = Quartale(I) + 1
Next
For
I = 1
To
4
If
MSG =
""
Then
MSG = I &
". Qartal: "
& Quartale(I)
Else
MSG = MSG &
"|"
& I &
". Qartal: "
& Quartale(I)
End
If
Next
MsgBox MSG
End
Sub
Public
Function
Quartal(dat)
As
Integer
Quartal = DatePart(
"q"
, dat, vbMonday, vbFirstFourDays)
End
Function