Dim Rng
Rng = Range("Table1")

' ==========ПОИСК ЧЕРЕЗ ОБРАЩЕНИЕ К ПЕРЕМЕННОЙ СОДЕРЖАЩЕЙ ДИАПАЗОН==========
Sub find2()
Dim xx1, xx2, xx3 As Double
Dim Rng As Range, arr(), cell
arr = Range("Table1").Value
X_find = Cells(9, 5) ' искомое слово
xx = Cells(12, 5) ' число раз поиска
T = Timevbb:
        For Each cell In arr
            If cell = X_find Then
            m = m + 1
            End If
        Next cell
If m = 0 Then: MsgBox ("нет такого слова"): Exit Sub
If m < xx Then: GoTo vbb
xx1 = Application.RoundUp(Time, 2)
xx2 = Application.RoundUp(T, 5)
xx3 = Application.RoundUp((Time - T) * 100000, 2)
MsgBox ("найдено за " & xx3 & " сек")
End Sub

' ==========ПОИСК ЧЕРЕЗ ОБРАЩЕНИЕ К ПЕРЕМЕННОЙ СОДЕРЖАЩЕЙ ДИАПАЗОН==========
Sub find2()
Dim i&, X_find$, cell, m&
Dim arr(), dic1 As Object, xx&, t As Date
Set dic1 = CreateObject("Scripting.Dictionary")
arr = Range("Table1").Value
X_find = Cells(9, 5) ' искомое слово
xx = Cells(12, 5) ' число раз поиска
t = Timer
For Each cell In arr
    dic1.Item(CStr(cell)) = 0
Next cell
For i = 1 To xx
    If dic1.exists(X_find) Then m = m + 1
Next i
Debug.Print m
If m = 0 Then: MsgBox ("нет такого слова"): Exit Sub
Debug.Print m
MsgBox Format(Timer - t, "0.000")
End Sub