Sub ok()
Dim Tbl, i As Long, L As Long, DerL As Long
Dim MonDico As Object, Item
Application.ScreenUpdating = False
With Worksheets("Feuil1")
.Unprotect
.Range("A1").Sort Key1:=.Columns("A"), Header:=xlGuess
DerL = .Range("A65536").End(xlUp).Row
Tbl = .Range("A2:C" & DerL)
.Protect
End With
'efface
Range("A10:C" & Range("A65536").End(xlUp).Row + 1).ClearContents
L = 10
Set MonDico = CreateObject("scripting.dictionary")
'catégorie,type sans doublon
Select Case Feuil1.ComboBox1
Case Feuil1.ComboBox1.Value
'catégorie,type sans doublon
For i = 1 To UBound(Tbl, 1)
If Tbl(i, 1) = "fruit" And Not MonDico.Exists(Tbl(i, 1) & "-" & Tbl(i, 2)) Then MonDico.Add Tbl(i, 1) & "-" & Tbl(i, 2), Tbl(i, 1) & "-" & Tbl(i, 2)
Next i
For Each Item In MonDico.items
Range("A" & L) = Left(Item, InStr(Item, "-") - 1)
Range("B" & L) = Mid(Item, InStr(Item, "-") + 1)
For i = 1 To UBound(Tbl, 1)
If Tbl(i, 1) & "-" & Tbl(i, 2) = Item Then
Range("C" & L) = Range("C" & L) & Tbl(i, 3) & ","
End If
Next i
Range("C" & L) = Left(Range("C" & L), Len(Range("C" & L)) - 1)
L = L + 1
Next Item
'Case "legume"
' 'catégorie,type sans doublon
' For i = 1 To UBound(Tbl, 1)
' If Tbl(i, 1) = "legume" And Not MonDico.Exists(Tbl(i, 1) & "-" & Tbl(i, 2)) Then MonDico.Add Tbl(i, 1) & "-" & Tbl(i, 2), Tbl(i, 1) & "-" & Tbl(i, 2)
' Next i
' For Each Item In MonDico.items
' Range("A" & L) = Left(Item, InStr(Item, "-") - 1)
' Range("B" & L) = Mid(Item, InStr(Item, "-") + 1)
' For i = 1 To UBound(Tbl, 1)
' If Tbl(i, 1) & "-" & Tbl(i, 2) = Item Then
' Range("C" & L) = Range("C" & L) & Tbl(i, 3) & ","
' End If
' Next i
' Range("C" & L) = Left(Range("C" & L), Len(Range("C" & L)) - 1)
' L = L + 1
' Next Item
Case "tout"
'catégorie,type sans doublon
For i = 1 To UBound(Tbl, 1)
If Not MonDico.Exists(Tbl(i, 1) & "-" & Tbl(i, 2)) Then MonDico.Add Tbl(i, 1) & "-" & Tbl(i, 2), Tbl(i, 1) & "-" & Tbl(i, 2)
Next i
For Each Item In MonDico.items
Range("A" & L) = Left(Item, InStr(Item, "-") - 1)
Range("B" & L) = Mid(Item, InStr(Item, "-") + 1)
For i = 1 To UBound(Tbl, 1)
If Tbl(i, 1) & "-" & Tbl(i, 2) = Item Then
Range("C" & L) = Range("C" & L) & Tbl(i, 3) & ","
End If
Next i
Range("C" & L) = Left(Range("C" & L), Len(Range("C" & L)) - 1)
L = L + 1
Next Item
Case Else
Exit Sub
End Select
Range("A9:C" & DerL).Sort Key1:=Range("A10"), Order1:=xlAscending, Key2:=Range("B10"), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
Feuil1.ComboBox1.Value = ""
End Sub