Yıl aralıklarının toplamını bulma (acil)

[balanar]

merhaba, a sutununda mevcut calısma sürelerinin D sutununda toplam şartlara göre toplatmak göstermek istiyorum

 

[veyselemre]

Sub test()
    Range("E2:F6").ClearContents
    For i = 2 To Cells(Rows.Count, 1).End(3).Row
        bl = Split(Replace(Cells(i, 1).Value, ".", ""), " ")
        If UBound(bl) > 0 Then
            yil = 0: ay = 0: gun = 0
            For ii = 1 To UBound(bl) Step 2
                Select Case bl(ii)
                    Case "Yıl": yil = bl(ii - 1)
                    Case "Ay": ay = bl(ii - 1)
                    Case "Gün": gun = bl(ii - 1)
                End Select
            Next ii
            toplam = yil * 360 + ay * 30 + gun
            Cells(i, 2).Value = toplam
            Select Case yil
                Case 0
                    sat = 2
                Case 1 To 4
                    sat = 3
                Case 5 To 9
                    sat = 4
                Case 10 To 19
                    sat = 5
                Case Else
                    sat = 6
            End Select
            Cells(sat, 5).Value = Cells(sat, 5).Value + 1
            Cells(sat, 6).Value = Cells(sat, 6).Value + toplam
        End If
    Next i
End Sub