Re,
Excel ne propose un nombre de filtres important pour les dates, mais pas pour les semaines.
C'était un plus. maintenant, c'est à toi de décider de l'utilité...
J'ai revu la feuille TCD LIEU en modifiant la procédure VBA, que tu as certainement remarqué.
On code en dur, alors si on ajoute une colonne dans le TCD, c'est chaud.
A te relire.
Cdlt.
Option Explicit
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim ACell As Range, rngData As Range
Dim lastRow As Long, rw As Long, i As Long
Application.ScreenUpdating = False
'---------------------------------------------------------------------
' KMS
'---------------------------------------------------------------------
Set ACell = Target.PivotFields("KILOMETRES ").DataRange.Cells(1)
Set rngData = Target.PivotFields("EVOLUTION KMS").DataRange
[K3].Value = ACell.Value
With [K4]
.Value = Application.Sum(rngData)
.NumberFormat = "[Blue]+#,##0;[Red](#,##0);"
End With
[K5].Value = ACell + Application.Sum(rngData)
[K3,K5].NumberFormat = "#,##0"
'---------------------------------------------------------------------
' VOLUME
'---------------------------------------------------------------------
Set rngData = Target.PivotFields("CUMUL VOLUME").DataRange
With [L5]
.Value = Application.Max(rngData)
.NumberFormat = "[Blue]+#,##0.00;[Red](#,##0.00);"
End With
'---------------------------------------------------------------------
' CONSOMMATION
'---------------------------------------------------------------------
With Columns(8)
.ClearContents
.Style = "Normal"
End With
[H2] = "Consommation"
[H3] = "(L/100)"
lastRow = Cells(Rows.Count, 4).End(xlUp).Row
If lastRow = 4 Then Exit Sub
rw = 5
For i = 5 To lastRow
If (Cells(i, "D") - Cells(i - 1, "D")) = 0 Then
Cells(rw, "H") = "kms. constant"
Else
Cells(rw, "H") = Cells(i - 1, "G") * 100 / (Cells(i, "D") - Cells(i - 1, "D"))
Cells(rw, "H").NumberFormat = "#,##0.00"
End If
If Cells(rw, "H") <= 0 Then Cells(rw, "H") = "évol. kms. négative"
rw = rw + 1
Next
Range(Cells(2, "H"), Cells(lastRow, "H")).Style = "20 % - Accent1"
Application.ScreenUpdating = True
Set rngData = Nothing: Set ACell = Nothing
End Sub