Bonjour Monique, Didier, Jean-Marie, Niko, Pittex
Juste pour Jean Marie (Ch'ti) voici le code de didier de la derniere macro tablo en "Full Comments"
On Error Resume Next 'ICI on place l'instruction pour gérer l'erreur en cas de doublon
'dans les "Key" dela "New Collection" => Co
For Each Cell In Plage
If Cell.Interior.ColorIndex = 3 Then
Co.Add Cell.Value, CStr(Cell.Value) 'ICI on ajoute chaque cellule, et on remet la même "String"
'en tant que "Key" (ce qui provoque une erreur en cas de
'doublon dans cette clef qui ne peut être unique
End If
Next Cell
On Error GoTo 0
'Tri
For i = 1 To Co.Count - 1 'ICI on lance une Boucle sur le nombre d'Item de la Collection
For i2 = i + 1 To Co.Count 'ICI on lance une seconde Boucle imbriquée et décalée inférieurement
If Co(i) > Co(i2) Then 'ICI on test si la Valeur dans la Boucle primaire est supérieure à la seconde
Temp1 = Co(i) 'Si oui on récupère la valeur dans une variable temporaire
Temp2 = Co(i2) 'Idem
Co.Add Temp1, before:=i2 'on déplace les valeurs
Co.Add Temp2, before:=i ' Idem
Co.Remove i + 1 'on supprime les anciennes
Co.Remove i2 + 1 'idem
End If
Next i2
Next i
ReDim Liste(2, Co.Count) 'ICI On dimensionne un tableau séquentiel (2 colonnes, X lignes (BASE 0)
For i = 1 To Co.Count 'on lance la boucle
Liste(0, i - 1) = Co(i) 'on entre la valeur dans ce tableau
For Each Cell In Plage
If Cell.Value = Liste(0, i - 1) Then 'ICI on compare les cellules avec le tableau (Col 0, Ligne i -1)
Liste(1, i - 1) = Liste(1, i - 1) + 1 'et si ça match on compte les occurrences
End If
Next Cell
Next i
'on envoie le tableau dans la plage
With Sheets(1)
.Range(.Cells(1, 1), .Cells(2, UBound(Liste, 2))).Value = Liste
End With
NB j'ai dimensionné le Tablo en Base Zéro, car soit on bascule en Option Base 1, et on fait comme Didier, soit on reste en Base Zéro, mais il vaut mieux éviter de forcer en Redim un tablo hybride.
NB voir le "Kiki de Zon" en pages Wiki, qui tente d'être explicatif là dessus.
Bonne Journée
@+Thierry
