Sub Supprimer_Lignes_avec_TCD()
Dim pvt As PivotTable, pvtCache As PivotCache, sTableau$
Dim T0
T0 = Timer
Application.ScreenUpdating = False
With Range("C2:C" & Cells(Rows.Count, 1).End(3).Row)
.FormulaR1C1 = "=IF(AND(COUNTA(RC[-2]:RC[-1])=2,RC[-2]=RC[-1]),""doublons""&ROW(),ROW())"
.Value = .Value
End With
[C1] = "UNIQUES"
sTableau = [A1].Parent.Name & "!" & [A1].CurrentRegion.Address(ReferenceStyle:=xlR1C1)
Sheets.Add
ActiveSheet.Name = "tmp"
Set pvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=sTableau)
Set pvt = pvtCache.CreatePivotTable(TableDestination:="tmp!R3C1", TableName:="TCD1")
With pvt.PivotFields("UNIQUES")
.Orientation = xlRowField
.Position = 1
End With
pvt.AddDataField pvt.PivotFields("COLA"), "Somme de COLA", xlSum
pvt.AddDataField pvt.PivotFields("COLB"), "Somme de COLB", xlSum
pvt.PivotFields("UNIQUES").PivotFilters.Add2 Type:=xlCaptionDoesNotContain, Value1:="doublons"
Columns("A:C").Copy: Columns("A:C").PasteSpecial -4163: Application.CutCopyMode = False
Columns(1).Delete: Rows("1:4").EntireRow.Delete
Debug.Print " Temps de traitement : " & Round(1000 * (Timer - T0)) & "ms."
End Sub