Sub test(occurs As String)
Dim c As Range, Ctr As Double, x As Range
Dim Ligne As Long, LigneDeb As Long, LigneCred As Long
Dim Min As Date, Dico As Object
With Sheets(occurs)
Ligne = 2
Set Dico = CreateObject("Scripting.Dictionary")
For Each c In .Range(.[E4], .Cells(Rows.Count, 5).End(xlUp))
If Not Dico.exists(DateSerial(Year(c.Value), Month(c.Value), 1)) Then
Dico.Add DateSerial(Year(c.Value), Month(c.Value), 1), _
DateSerial(Year(c.Value), Month(c.Value), 1)
End If
Next c
.[AH:AH].ClearContents
i = 0
For Each Item In Dico.items
i = i + 1
.Cells(i, "AH") = Item
Next Item
.[AH:AH].Sort .Range("AH1"), xlAscending, Header:=xlNo
For Each x In Range(.[AH1], .Cells(Rows.Count, "AH").End(xlUp))
Ctr = 0
Ligne = Ligne + 2
.Cells(Ligne, 40) = DateSerial(Year(x.Value), Month(x.Value), 1)
.Cells(Ligne, 40).NumberFormat = "mmm-yyyy"
LigneDeb = Ligne
LigneCred = Ligne
For Each c In Range(.[E4], .Cells(Rows.Count, 5).End(xlUp))
If DateSerial(Year(c.Value), Month(c.Value), 1) = .Cells(Ligne, 40) Then
If c.Offset(, 2) > 0 Then
.Cells(LigneCred, "AO") = .Cells(c.Row, 3)
.Cells(LigneCred, "AP") = .Cells(c.Row, 5)
.Cells(LigneCred, "AR") = .Cells(c.Row, 8)
.Cells(LigneCred, "AQ") = .Cells(c.Row, 7)
Ctr = Ctr + .Cells(c.Row, 7)
LigneCred = LigneCred + 1
Else
.Cells(LigneDeb, "AJ") = .Cells(c.Row, 3)
.Cells(LigneDeb, "AK") = .Cells(c.Row, 5)
.Cells(LigneDeb, "AM") = .Cells(c.Row, 8)
.Cells(LigneDeb, "AL") = .Cells(c.Row, 7)
Ctr = Ctr + .Cells(c.Row, 7)
LigneDeb = LigneDeb + 1
End If
End If
Next c
.Cells(Ligne + 1, 40) = Ctr
.Cells(Ligne + 1, 40).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
Ligne = Application.Max(LigneCred, LigneDeb)
Next x
.[AH:AH].ClearContents
End With
End Sub