cathodique
XLDnaute Barbatruc
Bonjour,
Après une recherche infructueuse, je vous soumets mon problème.
Sur la feuille BD, colA des dates, col B et C des montants. Je voudrais mettre en place des autofiltres, pour le journalier c'est ok. Je récupère les dates dans un dictionnaire sur lequel je boucle pour filtrer.
Par contre je n'arrive pas à filtrer par rapport au mois (pour trimestre pas encore abordé).
Je refais la même chose sauf que dans le dictionnaire, je récupère les mois.
Merci par avance.
Après une recherche infructueuse, je vous soumets mon problème.
Sur la feuille BD, colA des dates, col B et C des montants. Je voudrais mettre en place des autofiltres, pour le journalier c'est ok. Je récupère les dates dans un dictionnaire sur lequel je boucle pour filtrer.
Par contre je n'arrive pas à filtrer par rapport au mois (pour trimestre pas encore abordé).
Je refais la même chose sauf que dans le dictionnaire, je récupère les mois.
VB:
Option Explicit
Sub Calculs() 'en utilisant Filtrages successifs
Dim i As Long, j As Long, k As Long, NBd As Long, NCr As Long, dl As Long
Dim derlig As Long, Dercol As Integer, 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")
ShBd.AutoFilterMode = False
NBd = ShBd.Cells(ShBd.Rows.Count, 1).End(xlUp).Row
With ShSyn
Période = .Range("D1").Value
dl = .Cells(.Rows.Count, 1).End(xlUp).Row
If dl > 5 Then .Range("A6:I" & dl).Rows.Delete
With ShBd
'MsgBox Month(cle)
Select Case Période
Case "Par date"
Set Ddate = CreateObject("Scripting.Dictionary") 'date sans doublon
For Each c In .Range("A6:A" & NBd)
Ddate(c.Value) = ""
Next c
For Each cle In Ddate
.Range("A1:I" & NBd).AutoFilter Field:=1, Criteria1:=Format(cle, "dd/mm/yyyy")
derlig = ShSyn.Cells(.Rows.Count, 1).End(xlUp).Row
ShSyn.Cells(derlig + 1, 1) = cle
'code 9 pour somme - code 101= moyenne
ShSyn.Cells(derlig + 1, 2) = WorksheetFunction.Subtotal(9, ShBd.Columns(2))
ShSyn.Cells(derlig + 1, 3) = WorksheetFunction.Subtotal(9, ShBd.Columns(3))
Next cle
Case "Mensuel"
Set Ddate = CreateObject("Scripting.Dictionary") 'date sans doublon
For Each c In .Range("A6:A" & NBd)
Ddate(Month(c.Value)) = ""
Next c
For Each cle In Ddate
.Range("A1:I" & NBd).AutoFilter Field:=1, Criteria1:=cle
derlig = ShSyn.Cells(.Rows.Count, 1).End(xlUp).Row
ShSyn.Cells(derlig + 1, 1) = Format(Month(cle), "mmmm")
ShSyn.Cells(derlig + 1, 2) = WorksheetFunction.Subtotal(9, ShBd.Columns(2))
ShSyn.Cells(derlig + 1, 3) = WorksheetFunction.Subtotal(9, ShBd.Columns(3))
Next cle
Case "Trimestriel"
'en instance
Case "Annuel"
'en instance
End Select
.AutoFilterMode = False
End With
End With
Set ShBd = Nothing
Set ShSyn = Nothing
End Sub
). Désolé 
