|
Hilft dir das weiter?
Option Explicit
Private Sub AufträgeQuartal()
Dim AV, Quartale&(), MSG$
Dim R&, I%, E&, LR&
ReDim Quartale(1 To 4)
With ActiveSheet
LR = .Cells(2, 1).End(xlDown).Row
AV = .Range(.Cells(2, 1), .Cells(LR, 3)).Value
End With
E = UBound(AV)
For R = 1 To E
I = Quartal(AV(R, 2))
Quartale(I) = Quartale(I) + AV(R, 3)
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
|