Voilà, on arrive
Comme toujours en informatique,
voici une solution à ton problème
Pour l'activer une fois que tu l'auras copiée dans VBA,
tu placeras un bouton (Barre d'outils Formulaire) sur ta feuille excel,
Tu relieras ce bouton à la macro qui porte le nom de la procédure ci-dessous,
Quand tu cliques sur ce bouton, tu exécutes la procédure.
'********* Copier depuis ici ***********
Sub CptDiffVal()
'Compte le nombre de valeurs différentes contenues dans une colonne.
Dim Li, Col, Buf1, Cpt1, CptLi, CptCol, I, J, K
'Si la colonne à analyser ne commence pas à la ligne 3 de la colonne 1,
'changer les valeurs de Li et Col ci-dessous.
'------- !!! ATTENTION !!!
'--- Il ne faut pas de cellule vide dans la ligne n° 3
'--- ni dans la colonne n°1 dans cet exemple
Li = 3 'N° de la ligne où la liste des valeurs à compter commence
Col = 1 'N° de la colonne où la liste des valeurs à compter commence
'Initialiser les variables
CptLi = 0
CptCol = 0
Cpt1 = 0
'------------------------------------------------------------------------
'--- S'il y a, par exemple une ligne pour le titre des colonnes
'--- et une seconde ligne pour séparer les titres des données, par exemple,
'--- alors les données commencent à la ligne 3 de la colonne 1
CptLi = 0
CptCol = 0
'--- Le raisonnement est le même s'il y a des nomls de lignes dans la 1° colonne
'--- Compter le nombre de lignes à analyser
For I = Li To 65535
If IsEmpty(ActiveSheet.Cells(I, Col)) = False Then
CptLi = CptLi + 1
Else
Exit For
End If
Next I
'--- Compter le nombre de colonnes à analyser
For J = Col To 65535
If IsEmpty(ActiveSheet.Cells(Li, J)) = False Then
CptCol = CptCol + 1
Else
Exit For
End If
Next J
'-------------------------------------------------------------------------
'Trier l'ensemble des cellules par ordre croissant
'--- 'Sélection de la zone à trier par ordre croissant
ActiveSheet.Range(Cells(Li, Col), Cells((Li - 1) + CptLi, (Col - 1) + CptCol)).Select
'--- 'Trier la zone de cellules par ordre croissant
Selection.Sort Key1:=ActiveSheet.Cells(Li, Col), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'--- 'Se positionner sur une cellule
ActiveSheet.Cells(Li, Col).Select
'Compter le nombre de valeurs différentes contenues dans la colonne choisie
Buf1 = ActiveSheet.Cells(Li, Col).Value
Cpt1 = 1
For K = Li To (Li - 1) + CptLi 'Lire chaque cellule de la colonne
'--- 'Si une valeur différente de la précédante dans la cellule visitée
If ActiveSheet.Cells(K, Col) <> Buf1 Then
Cpt1 = Cpt1 + 1 'Incrémenter le compteur
Buf1 = ActiveSheet.Cells(K, Col).Value
End If
Next K
ActiveSheet.Cells(K, Col).Value = Cpt1 'Récupère le nombre de valeurs différentes
End Sub
'********* Copier jusqu'ici ***********
Je pense qu'elle est suffisament documentée pour comprendre son déroulement
Pour celui qui souhaite la voir fonctionner ligne par ligne,
depuis l'éditeur VBA, faire F8, la ligne exécutée est surlignée en jaune.
Vous pouvez aller voir le résultat dans votre feuille Excel après chaque ligne de code exécutée.
A+