rebonsoir
oui Jean marie voilà le code
tu reconnaitra une partie
Sub x()
Dim Debut As Date, NbreL As Integer
Dim Tablo As Variant, I As Integer
Dim ColData As Collection, NameAddress As String, SheetName As String
Debut = Time
With Application
.ScreenUpdating = False 'True
.Calculation = xlCalculationManual 'Automatic
End With
With Sheets('data2')
'code
Tablo = .Range('D5
' & .Range('D65536').End(xlUp).Row)
.Range('G5:M' & .Range('G65536').End(xlUp).Row).ClearContents
Set ColData = New Collection 'une collection,c'est sans doublons
For I = LBound(Tablo, 1) To UBound(Tablo, 1)
On Error Resume Next
ColData.Add CStr(Tablo(I, 1)), CStr(Tablo(I, 1))
On Error GoTo 0
Next I
I = 1
For Each Item In ColData
I = I + 1
.Range('G' & I + 4) = Item
Next Item
Set ColData = Nothing
.Range('G5:G' & .Range('G65536').End(xlUp).Row + 1).Sort Key1:=.Range('G5'), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
'dep
.Range('A5
' & .Range('G65536').End(xlUp).Row + 1).Sort Key1:=.Range('A5'), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Tablo = .Range('A5:A' & .Range('A65536').End(xlUp).Row)
Set ColData = New Collection 'une collection,c'est sans doublons
For I = LBound(Tablo, 1) To UBound(Tablo, 1)
On Error Resume Next
ColData.Add CStr(Tablo(I, 1)), CStr(Tablo(I, 1))
On Error GoTo 0
Next I
I = 9
For Each Item In ColData
.Cells(4, I) = Item
I = I + 1
Next Item
Set ColData = Nothing
L = .Range('A65536').End(xlUp).Row ' + 1
SheetName = '=' & .Name & '!'
NameAddress = .Range('B5:B' & L).Address
ActiveWorkbook.Names.Add Name:='ColB', RefersTo:=SheetName & NameAddress
NameAddress = .Range('D5
' & L).Address
ActiveWorkbook.Names.Add Name:='ColD', RefersTo:=SheetName & NameAddress
Tablo = .Range('G5:O' & .Range('G65536').End(xlUp).Row + 1)
'SUMPRODUCT(CDE*(CODE=$G2));SOMMEPROD(CDE*(CODE=TEXTE($G2;0))
For I = LBound(Tablo, 1) To UBound(Tablo, 1)
'numérique ok,texte erreur
Tablo(I, 2) = Evaluate('SUMPRODUCT((ColD=' & Tablo(I, 1) & ')*ColB)')
Next I
End With
End Sub
à bientôt