Bonjour,
Bonjour FINDRH,
La même mais différente.
ALT F8 et exécuter la procédure.
Cdlt.
Option Explicit
Public Sub ProcessData()
Dim wb As Workbook
Dim wsData As Worksheet, wsResult As Worksheet
Dim rngData As Range
Dim lRow As Long
Dim PTCache As PivotCache
Dim pt As PivotTable
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb = ActiveWorkbook
Set wsData = wb.Worksheets("Base")
On Error Resume Next
wb.Worksheets("Résultat").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set rngData = wsData.Cells(1).CurrentRegion
Set PTCache = wb.PivotCaches.Create(xlDatabase, rngData)
wb.Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Résultat"
Set pt = PTCache.CreatePivotTable(Cells(3, 1), "PT_1")
With pt
.ManualUpdate = True
.AddFields RowFields:=Array("Matricule dans reflex", "Date validation mouvement")
With .PivotFields("Heure validation h:m2")
.Orientation = xlDataField
.Position = 1
.Function = xlMax
.Caption = "Max "
.NumberFormat = "h:mm;@"
End With
With .PivotFields("Heure validation h:m")
.Orientation = xlDataField
.Position = 2
.Function = xlMin
.Caption = "Min "
.NumberFormat = "h:mm;@"
End With
.RowAxisLayout xlTabularRow
.RepeatAllLabels xlRepeatLabels
.ColumnGrand = False
.PivotFields("Matricule dans reflex").Subtotals(1) = False
.PivotFields("Matricule dans reflex").Caption = "Matricule"
.PivotFields("Date validation mouvement").Caption = "Date validation"
.ManualUpdate = False
.TableRange1.Offset(1, 0).Resize(.TableRange1.Rows.Count - 1).Copy
End With
[F4].PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
[J4] = "Durée"
lRow = Cells(Rows.Count, "F").End(xlUp).Row
Range(Cells(5, "J"), Cells(lRow, "J")).FormulaR1C1 = "=MOD(RC[-2]-RC[-1],1)"
Range(Cells(5, "J"), Cells(lRow, "J")).Value = Range(Cells(5, "J"), Cells(lRow, "J")).Value
[A1:D1].EntireColumn.Delete
ActiveSheet.ListObjects.Add xlSrcRange, [B4].CurrentRegion, , xlYes
[B4].Select
Set pt = Nothing: Set PTCache = Nothing
Set rngData = Nothing
Set wsData = Nothing
Set wb = Nothing
End Sub