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 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45
| Sub CAduMois()
Dim LaDate As Range, MonMois As Byte, I As Long, L As Long
MonMois = InputBox("Mois en chiffre - Janvier=1, Février=2, etc.)")
If MonMois < 1 And MonMois > 12 Then Exit Sub
Range("A1") = Choose(MonMois, "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")
Range("A4:T42").ClearContents
With Worksheets("Listing")
.Range("B3:B" & .Range("B5000").End(xlUp).Row).NumberFormat = "m"
Set LaDate = .Columns(2).Find(MonMois, LookIn:=xlValues)
L = 3
If Not LaDate Is Nothing Then
firstAddress = LaDate.Address
Do
L = L + 1
li = LaDate.Row
Cells(L, 1) = .Cells(li, 1)
Cells(L, 2) = .Cells(li, 2): Cells(L, 2).NumberFormat = "dd/mm/yyyy"
Cells(L, 3) = .Cells(li, 3)
Cells(L, 4) = .Cells(li, 5)
Cells(L, 5) = .Cells(li, 7)
Cells(L, 6).Formula = "=H" & L & "+J" & L & "+L" & L & "+N" & L & "+P" & L
Cells(L, 7) = .Cells(li, "AL")
Cells(L, 8) = .Cells(li, "AM")
Cells(L, 9) = .Cells(li, "CV")
Cells(L, 10) = .Cells(li, "CW")
Cells(L, 11) = .Cells(li, "FI")
Cells(L, 12) = .Cells(li, "FJ")
Cells(L, 13) = .Cells(li, "HV")
Cells(L, 14) = .Cells(li, "HW")
Cells(L, 15) = .Cells(li, "IS")
Cells(L, 16) = .Cells(li, "IT")
Set LaDate = .Columns(2).FindNext(LaDate)
Loop While Not LaDate Is Nothing And LaDate.Address <> firstAddress
End If
.Range("B3:B" & .Range("B5000").End(xlUp).Row).NumberFormat = "dd/mm/yyyy"
L = .Range("B5000").End(xlUp).Row
For I = 1 To 12
Cells(46 + I, 2) = Evaluate("sumproduct((month(listing!B3:B" & L & ")" & "=" & I & ")*listing!J3:J" & L & ")")
Next I
End With
End Sub |
Partager