Поиск уникальных строк

Sub xxx() ' для A1
Dim Num, I, I1, Cel, Cel1
Num = Range('A1').SpecialCells(xlCellTypeLastCell).Row
For I = 1 To Num - 1
 Cel = Cells(I, 1)
 For I1 = I + 1 To Num
  Cel1 = Cells(I1, 1)
  If Cel1 = Cel Then
   Cells(I1, 1).Select
   With Selection.Interior
    .ColorIndex = 36
    .Pattern = xlSolid
   End With
  End If
 Next
Next I
End Sub

Private sub Проверка()
Dim myDic As Dictionary
Set myDic = New Dictionary
Dim i As Integer
 
For each mV in ActiveSheet.UsedRange.cellse
   if mv.value<> empty then
      If myDic.Exists(mV.value) = False Then
         mV.interior.colorindex=3
      else
        myDic.Add mV.value,''
      End If
   End if
Next mV
 
Set myDic = Nothing
End sub

Dim myDic As DictionarySet
myDic = New Dictionary

Set myDic = CreateObject('Scripting.Dictionary')

If myDic.Exists(mV.Value) = False Then

If myDic.Exists(mV.Value) = True Then

Sub НайтиПовторы()
  Set myDic = CreateObject('Scripting.Dictionary')
  Dim iNumUniq, iNumRep, iNumEmp As Integer
  iNumUniq = iNumRep = iNumEmp = 0
  firstRow = activecell.Row
  Column = activecell.Column
  Column2 = Column + 1
  Columns(Column + 1).Insert
  With Columns(Column2)
    .Interior.ColorIndex = 15
    .NumberFormat = 'General'
  End With
  For i = firstRow To ActiveSheet.UsedRange.Rows.Count
    With ActiveSheet.Cells(i, Column)
      If .Value <> Empty Then
        If myDic.Exists(.Value) = True Then
          iNumRep = iNumRep + 1
          ActiveSheet.Cells(i, Column2).Interior.ColorIndex = 3
          ActiveSheet.Cells(i, Column2).Value = myDic.Item(.Value)
        Else
          iNumUniq = iNumUniq + 1
          ActiveSheet.Cells(i, Column2).Value = iNumUniq
          myDic.Add .Value, iNumUniq
        End If
      Else
        iNumEmp = iNumEmp + 1
      End If
    End With
  Next i
  Set myDic = Nothing
  MsgBox 'Обработано ячеек:' + Str(i - firstRow) + Chr(13) + 'Найдено уникальных ячеек:' + Str(iNumUniq) + Chr(13) + 'Найдено повторяющихся ячеек:' + Str(iNumRep) + Chr(13) + 'Найдено пустых значений:' + Str(iNumEmp)
End Sub

Private Sub Проверка()
Dim myDic As New Dictionary, i As Integer
For Each mV In ActiveSheet.UsedRange.Cells 'UsedRange.columns(1).cells
  If mV.Value <> Empty Then
   If myDic.Exists(mV.Value) = True Then
     mV.Interior.ColorIndex = 0
   Else
     myDic.Add mV.Value, ''
     mV.Interior.ColorIndex = 3
   End If
  End If
Next mV
 
Set myDic = Nothing
End Sub

Private Sub Проверка()
 Dim myDic As Dictionary
 Set myDic = New Dictionary
 Dim i As Integer
 Worksheets('Лист1').Activate
 q = q
 For Each mV In ActiveSheet.UsedRange.Cells
  If mV.Value <> Empty Then
   If myDic.Exists(mV.Value) = False Then
    myDic.Add mV.Value, ''
   Else
    mV.Interior.ColorIndex = 3
   End If
  End If
  Next mV
  Set myDic = Nothing
End Sub