1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
| Sub essai_SommeSi_mois()
Dim mois As Byte, An As Integer, derlig As Integer, NBd As Long
Dim TotMoisD As Currency, TotMoisR As Currency
Dim ShBd As Worksheet, ShSyn As Worksheet
Dim c As Range, Ddate As Object, Cle, Période As String
Application.ScreenUpdating = False
'On Error Resume Next
Set ShBd = Worksheets("BD")
Set ShSyn = Worksheets("MaFeuille")
NBd = ShBd.Cells(ShBd.Rows.Count, 1).End(xlUp).Row
derlig = 6
For An = Year(WorksheetFunction.Min(ShBd.Range("A2:A" & NBd))) To Year(WorksheetFunction.Max(ShBd.Range("A2:A" & NBd)))
For mois = 1 To 12
TotMoisR = WorksheetFunction.SumIfs(ShBd.Range("B2:B" & NBd), ShBd.Range("A2:A" & NBd), ">=" & mois & "/01/" & An, ShBd.Range("A2:A" & NBd), "<" & WorksheetFunction.EoMonth(mois & "/01/" & An, 0))
TotMoisD = WorksheetFunction.SumIfs(ShBd.Range("c2:c" & NBd), ShBd.Range("A2:A" & NBd), ">=" & mois & "/01/" & An, ShBd.Range("A2:A" & NBd), "<" & WorksheetFunction.EoMonth(mois & "/01/" & An, 0))
If TotMoisR <> 0 Or TotMoisD <> 0 Then
ShSyn.Cells(derlig, 1) = Format(CDate("01/" & mois & "/" & An), "mmmm yyyy")
ShSyn.Cells(derlig, 2) = TotMoisR
ShSyn.Cells(derlig, 3) = TotMoisD
derlig = derlig + 1
End If
Next mois
Next An
End Sub |
Partager