Sub sdf()

   Dim vItem
   Dim dict As Object
   Dim Arr()
   
  Set dict = CreateObject("Scripting.Dictionary")
  With dict
  
      For Each vItem In Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
         If Trim(vItem) = "" Then
         .Item(Trim(vItem)) = .Item(Trim(vItem)) + 1
         End If
         
      Next
      If .Count Then [E2].Resize(.Count).Value = Application.WorksheetFunction.Transpose(.Keys)
      If .Count Then [F2].Resize(.Count).Value = Application.WorksheetFunction.Transpose(.Items)
   End With

End Sub

Dim col As New Collection
On Error Resume Next 'при вводе неуникального значения генерируется ошибка, игнорируем ее
For Each vItem In Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
    col.Add vItem, vItem
Next

On Error Goto 0

For Each vItem In col
    Debug.Print vItem
Next

Dim col As New Collection
On Error Resume Next 'при вводе неуникального значения генерируется ошибка, игнорируем ее
For Each vItem In Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
    col.Add vItem, vItem
Next

On Error Goto 0

For Each vItem In col
    ListBox1.AddItem vItem
Next

Sub Макрос8()
k = "dfg"
Listbox.AddItem k

End Sub

Sub Макрос8()
k = "dfg"
Listbox1.AddItem k

End Sub