Sub ffffffff()
Dim a, x, i As Long
'как-то получили массив a
i = 0
For Each x In a 'For Each ... быстрее, чем For ... To... Даже с учетом i=i+1. А то Вы используете For to там где в этом нет необходимости.
  i = i + 1
  If d.exists(x) Then d(x) = d(x) & " " & i Else d(x) = i
Next
'Теперь у Вас есть Dictionary с уникальными значениями по Key
For Each x In d.Keys 'Прозваниваем по Key, ведь d.Keys - массив
'Если ошибки ситематические(т.е. имеют частые повторения), то этот способ принесет скорость.
'Если нет, то лучше по массиву сразу без создания Dictionary. Разница по времени может быть значительной
  If k Like "*ол*ко *во*ач*ва*" Then s = s & "|" & k
Next
aRes = Split(s, "|") 'получаем массив "как есть" соответствий ожидаемому условию начиная с нумерации = 1
End Sub

Sub FindLike()

Dim a()
Dim l As Long
Dim dic As New Dictionary
Dim t As Long
Dim sFind As String

t = Timer
a = [A2:A524289].Value2
sFind = Cells(9, 3)
For l = 1 To UBound(a)
    If a(l, 1) Like sFind Then
        dic.Add l, a(l, 1)
    End If
Next
Debug.Print (Timer - t) * 1000

End Sub