macro pour somme automatique selon critères

Sub Traitement()
Dim TabTemp As Variant
Dim Cumul As Double
Dim D As Date
Dim L As Long
      With Sheets('Feuil1')
            'Charge les données dans un tableau variant temporaire
            L = .Range('A65536').End(xlUp).Row
            TabTemp = .Range(.Cells(1, 1), .Cells(L, 3)).Value
            'La première date est la date de référence
            D = TabTemp(1, 1)
            'Pour chaque ligne
            For L = 1 To UBound(TabTemp, 1)
                  'Compare la date avec la date de référence
                  If TabTemp(L, 1) <> D Then
                        'Si nouvelle date alors MAJ du cumul dans la ligne précédente
                        .Cells(L - 1, 3) = Cumul
                        'Redéfinit la date de référence et le cumul
                        D = TabTemp(L, 1)
                        Cumul = TabTemp(L, 2)
                  Else
                        'Cumule de la colonne B
                        Cumul = Cumul + TabTemp(L, 2)
                  End If
            Next L
            'MAJ du dernier cumul
            .Cells(L - 1, 3) = Cumul
      End With
End Sub

Cliquez pour agrandir...

Sub Traitement()
Dim TabTemp As Variant, TabResult() As Variant
Dim Cumul As Double
Dim D As Date
Dim L As Long, R As Long
      With Sheets('Feuil1')
            'Charge les données dans un tableau variant temporaire
            L = .Range('A65536').End(xlUp).Row
            TabTemp = .Range(.Cells(1, 1), .Cells(L, 3)).Value
            'La première date est la date de référence
            D = TabTemp(1, 1)
            'Initialisation du tableau des résultats
            ReDim TabResult(1 To 2, 1 To 1)
            'Pour chaque ligne
            For L = 1 To UBound(TabTemp, 1)
                  'Compare la date avec la date de référence
                  If TabTemp(L, 1) <> D Then
                        'Si nouvelle date alors MAJ du cumul dans la ligne précédente
                        .Cells(L - 1, 3) = Cumul
                        'Stockage des résultats
                        TabResult(1, UBound(TabResult, 2)) = D
                        TabResult(2, UBound(TabResult, 2)) = Cumul
                        ReDim Preserve TabResult(1 To 2, 1 To UBound(TabResult, 2) + 1)
                              'pour dates inexistantes
                              For R = 1 To TabTemp(L, 1) - D - 1
                                    TabResult(1, UBound(TabResult, 2)) = D + R
                                    TabResult(2, UBound(TabResult, 2)) = 0
                                    ReDim Preserve TabResult(1 To 2, 1 To UBound(TabResult, 2) + 1)
                              Next R
                        'Redéfinition de la nouvelle date de référence et du cumul
                        D = TabTemp(L, 1)
                        Cumul = TabTemp(L, 2)
                  Else
                        'Cumule de la colonne B
                        Cumul = Cumul + TabTemp(L, 2)
                  End If
            Next L
            'MAJ du dernier cumul
            .Cells(L - 1, 3) = Cumul
            'Stockage du dernier cumul
            TabResult(1, UBound(TabResult, 2)) = D
            TabResult(2, UBound(TabResult, 2)) = Cumul
            'Affichage des résultats
            .Range(.Cells(1, 6), .Cells(UBound(TabResult, 2), 7)).Value = _
                  Application.WorksheetFunction.Transpose(TabResult)
      End With
End Sub

Cliquez pour agrandir...