Sub tt()
Dim i As Long, t As String, k
Set myDict=CreateObject("scripting.dictionary")
myDict.comparemode = 1 ''сравнение без учёта регистра
For i = 1 To [a1].End(xlDown).Row
t = Cells(i, 1): myDict(t) = myDict(t) + 1
Next
For Each k In myDict.keys
Debug.Print k & "/" & .Item(k)
Next
End Sub
myDict.RemoveAll
myDict.Remove(t)
myDict.Exists(t)