XL 2010 Somme.si par trimestre et par année [RESOLU]

cathodique · 31 Mars 2017

Bonjour,

Me revoilà, vous sollicitant pour un autre problème.

Soit en colonne A des dates et en colonne B des montants. Je voudrais avoir sur une autres feuilles la somme des montants par trimestres et année. ex T1-2016=x, T2-2016==y, T3-2016=z,T4-2016=w ... etc.
N'ayant pas trouvé l'astuce pour mettre dans une variable les trimestres pour réduire les lignes de code, j'ai opté pour un select case. Mais les résultats ne sont pas bons.

VB:

Sub Trimestrielle()
  Dim An As Integer, derlig As Integer, NBd As Long, Trime As Byte, dl As Long
  Dim TotRec As Currency, TotDep As Currency
  Dim ShBd As Worksheet, ShSyn As Worksheet
  Application.ScreenUpdating = False
  Set ShBd = Worksheets("BD")
  Set ShSyn = Worksheets("MaFeuille")

  NBd = ShBd.Cells(ShBd.Rows.Count, 1).End(xlUp).Row
  dl = ShSyn.Cells(ShSyn.Rows.Count, 1).End(xlUp).Row
  ShSyn.Range("a6:d" & dl).Clear
  derlig = 6
  For An = Year(WorksheetFunction.Min(ShBd.Range("A6:A" & NBd))) To Year(WorksheetFunction.Max(ShBd.Range("A6:A" & NBd)))
  For Trime = 1 To 4

  Select Case Trime
  Case 1
  TotRec = WorksheetFunction.SumIfs(ShBd.Range("B6:B" & NBd), ShBd.Range("A6:A" & NBd), _
  ">=" & " 01/01/" & An, ShBd.Range("A6:A" & NBd), _
  "<=" & WorksheetFunction.EoMonth("03/01/" & An, 0))
  TotDep = WorksheetFunction.SumIfs(ShBd.Range("C6:c" & NBd), ShBd.Range("A6:A" & NBd), _
  ">=" & "01/01/" & An, ShBd.Range("A6:A" & NBd), _
  "<=" & WorksheetFunction.EoMonth("03/01/" & An, 0))

  Case 2
  TotRec = WorksheetFunction.SumIfs(ShBd.Range("B6:B" & NBd), ShBd.Range("A6:A" & NBd), _
  ">=" & " 04/01/" & An, ShBd.Range("A6:A" & NBd), _
  "<=" & WorksheetFunction.EoMonth("06/01/" & An, 0))
  TotDep = WorksheetFunction.SumIfs(ShBd.Range("C6:c" & NBd), ShBd.Range("A6:A" & NBd), _
  ">=" & "04/01/" & An, ShBd.Range("A6:A" & NBd), _
  "<=" & WorksheetFunction.EoMonth("06/01/" & An, 0))

  Case 3
  TotRec = WorksheetFunction.SumIfs(ShBd.Range("B6:B" & NBd), ShBd.Range("A6:A" & NBd), _
  ">=" & " 07/01/" & An, ShBd.Range("A6:A" & NBd), _
  "<=" & WorksheetFunction.EoMonth("09/01/" & An, 0))
  TotDep = WorksheetFunction.SumIfs(ShBd.Range("C6:c" & NBd), ShBd.Range("A6:A" & NBd), _
  ">=" & "07/01/" & An, ShBd.Range("A6:A" & NBd), _
  "<=" & WorksheetFunction.EoMonth("09/01/" & An, 0))
  Case 4
  TotRec = WorksheetFunction.SumIfs(ShBd.Range("B6:B" & NBd), ShBd.Range("A6:A" & NBd), _
  ">=" & " 10/01/" & An, ShBd.Range("A6:A" & NBd), _
  "<=" & WorksheetFunction.EoMonth("12/01/" & An, 0))
  TotDep = WorksheetFunction.SumIfs(ShBd.Range("C6:c" & NBd), ShBd.Range("A6:A" & NBd), _
  ">=" & "10/01/" & An, ShBd.Range("A6:A" & NBd), _
  "<=" & WorksheetFunction.EoMonth("12/01/" & An, 0))

  End Select
  If TotRec <> 0 Or TotDep <> 0 Then
  ShSyn.Cells(derlig, 1) = "T" & Trime & "-" & An
  ShSyn.Cells(derlig, 1).HorizontalAlignment = xlCenter
  ShSyn.Cells(derlig, 2) = TotRec
  ShSyn.Cells(derlig, 3) = TotDep
  ShSyn.Cells(derlig, 4) = TotRec - TotDep
  ShSyn.Range(Cells(derlig, 1), Cells(derlig, 4)).Borders.Weight = xlThin
  derlig = derlig + 1
  End If
  Next Trime
Next An
End Sub

Il y a sûrement une grosse bêtise dans mon code. Merci de me "corriger"

EDIT: je viens de me rendre compte de grosses bêtises que j'ai faites. J'ai corrigé cependant, je n'ai pas compris pourquoi TotRec est nul pour tous les trimestres Alors queTotDep est juste.
edit

Merdoum... Que de bêtises! En vous voulant aller vite, le couper /coller de lignes de code presque identiques m'ont au contraire fait perdre du temps.
Merci beaucoup.

XL 2010 Somme.si par trimestre et par année [RESOLU]

cathodique

XLDnaute Barbatruc

Discussions similaires