Bonjour Musto
à tester
Il y a le cas de TR, dans la liste on voit duex TR. La cause c'est un espace.
Pour l'éviter il faut faire deux changement:
on Trim les valeurs:
Sub SansDoublons()
Dim rng As Range
Dim ListeInit As Range, Resultat As Range
Dim DerLigne As Integer
Set dt = CreateObject("Scripting.Dictionary")
DerLigne = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set ListeInit = Range("B2:D" & DerLigne)
Set Resultat = Range("F2")
For Each rng In ListeInit
If rng.Value <> "" Then
dt(Trim(rng.Value)) = ""
End If
Next
Resultat.Range("A1").Resize(dt.Count) = Application.WorksheetFunction.Transpose(dt.Keys)
Columns("F:F").Sort key1:=Range("F2"), order1:=xlAscending, Header:=xlYes
End Sub
et on adapte la formule en ajoutant un SUPPRESPACE:
=SIERREUR(SI(F2="";"";SOMMEPROD((ANNEE($A$2:$A$69)=ANNEE($G$1))*(MOIS($A$2:$A$69)=MOIS($G$1))*(SUPPRESPACE($B$2:$D$69)=F2)));"")
Un nouveau fichier avec les deux versions: