Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim uniqueValues As Collection
Dim countUnique As Integer
' Spécifie la feuille de calcul et la colonne à analyser
Set ws = ThisWorkbook.Sheets("Feuil1") ' Remplace "NomDeTaFeuille" par le nom de ta feuille
Set rng = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
' Initialise une collection pour stocker les valeurs uniques
Set uniqueValues = New Collection
' Parcours chaque cellule dans la plage
On Error Resume Next
For Each cell In rng
If cell.Value <> "" Then
uniqueValues.Add cell.Value, CStr(cell.Value)
End If
Next cell
On Error GoTo 0
' Compte les valeurs uniques
countUnique = uniqueValues.Count
' Affiche le résultat
MsgBox "Nombre de cellules non vides et uniques sans doublon : " & countUnique, vbInformation, "Résultat"
End Sub