Dim Rng_find As Range

Dim text_word2() As Variant
ReDim text_word2(0 To kki, 0 To x)- место ошибки
'Если ошибку отлавливать  
" On Error Resume Next
If Err.Number <> 0 Then
Err.Clear
End If"

On Error Resume Next

Dim ADO As New ADO
Dim Arr As Variant
    ADO.DataSource = "d:\ÀÒÁ àâãóñò 2015_ðûáà_649.xlsm"     
    ADO.Query ("SELECT * FROM [лист1$A:AC]")

Arr = ADO.ToArray()

Dim Arr As Variant
Set objConnection = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & "G:\0_ÂÎÄÍÛÉ_ÌÈÐ\ÀÒÁ\Àâãóñò\" & "\" & "ÀÒÁ àâãóñò 2015_ðûáà_649.xlsm" & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
sqlStr1 = "SELECT * FROM [áàçà$B:AC]"
rs.Open sqlStr1, objConnection, 3, 3


Dim text_word2() As Variant
ReDim text_word2(0 To kki, 0 To x)- место ошибки
'Если ошибку отлавливать  
" On Error Resume Next
If Err.Number <> 0 Then
Err.Clear
End If"

im text_word2() As Variant
ReDim text_word2(0 To kki, 0 To x)- место ошибки
'Если ошибку отлавливать  
" On Error Resume Next
If Err.Number <> 0 Then
Err.Clear
End If"

Dim n As Long
Dim nn As Long
Dim il As Long
Dim find As String
Dim k, kk, ii, i, j, jj, l, ll, jjj, i1, i2, kkk, j1, j2, j3, i3, jj3, eqmax As Long
Dim ii_find As Long
Dim jj_find As Long
Dim ii_text As Long
Dim jj_text As Long
Dim ii_text_ost As Long
Dim jj_text_ost As Long
Dim txt As String
Dim txt2 As String
Dim txt_p As String
Dim txt_col As String
Dim txt_row As String
Dim txt_out As String

    Dim Rng_find As Range
    Dim Rng_find1 As Range
    Dim Rng_text As Range
    Dim Rng_substitution As Range
    Dim Rng_out As Range
    Dim theRange_out As Range
    Dim Delimiter As String
Dim s_percent As Double

Dim Find_word() As String
Dim Find_word2() As String
Dim text_word1() As String
Dim text_word2() As Variant
Dim text_word3() As String

    On Error Resume Next
    Set Rng_find = Range(RefEdit1.Value)

    Set Rng_text = Range(RefEdit2.Value)
    Set Rng_substitution = Range(RefEdit3.Value)
    Set Rng_out = Range(RefEdit4.Value)
    Delimiter = Me.TextBox1
    s_percent = CDbl((Me.TextBox4.Value))
    
    On Error GoTo 0
    If Rng_find Is Nothing Then
        MsgBox "вы не выбрали диапазон какие данные ищем"
        Err.Clear
    Else
    If Rng_text Is Nothing Then
        MsgBox "вы не выбрали диапазон в котором ищем данные "
        Err.Clear
    Else
    
    If Rng_out Is Nothing Then
        MsgBox "вы не выбрали диапазон куда выводить данные"
        Err.Clear
    Else
    
    Application.ScreenUpdating = False
    On Error Resume Next: Err.Clear
    
        
    'раскладываем по словам искомый диапазон
    ii_find = myWord(Rng_find).imyRows
    jj_find = myWord(Rng_find).imyColumns
    
    
    ReDim Find_word(1 To ii_find, 0 To jj_find) ' 0-вой столбец фраза целиком
    Find_word = myWord(Rng_find).iFindword
    
    ' переводим в массив 2-ух строк
    ' 0 строка фраза целиком
    ' 1 строка разложение по словам
    ReDim Find_word2(0 To 2, 0 To (jj_find * ii_find))  '
    jjj = 1

    For i = 1 To ii_find
    For j = 1 To jj_find
        If ((Find_word(i, j) <> "") And (Find_word(i, j) <> " ") And (Find_word(i, j) <> Empty)) Then
        Find_word2(0, jjj) = Find_word(i, 0)
        Find_word2(1, jjj) = Find_word(i, j)
        jjj = jjj + 1
        End If
    Next j
    Next i
    
    'раскладываем по словам  диапазон в котором ищем
    ii_text = myWord(Rng_text).imyRows
    jj_text = myWord(Rng_text).imyColumns
    ReDim text_word1(1 To ii_text, 0 To jj_text) ' 0-вой столбец фраза целиком
    text_word1 = myWord(Rng_text).iFindword
'______________

    'перед тем как сравнивать 2-ва массива и класть их в третий    разбиваем их
    
    Dim coll_text_word As Collection_: Set coll_text_word = SplitArrayAll(text_word1, ii_find, jj_find, CLng(TextBox3.Text))
    
    Dim coll_Find_word As Collection_: Set coll_Find_word = SplitArrayAll(Find_word, ii_find, jj_find, CLng(TextBox2.Text))
    Dim arr_Find_word() As Variant
    Dim arr_text_word1() As Variant
    Dim my_row As Long
    
txt_p = Substring(RefEdit4.Text, "!", 1)
txt_col = Substring(Substring(RefEdit4.Text, "!", 2), "$", 2)
txt2 = Substring(Substring(RefEdit4.Text, "!", 2), "$", 3)
txt_row = Substring(txt2, ":", 1)

ii_text_ost = 0
my_row = 0
' выводим результаты массива поиска по частям
    For i = 1 To coll_text_word.Count
    For j = 1 To coll_Find_word.Count
        arr_Find_word = coll_Find_word.Item(j)
        arr_text_word1 = coll_text_word.Item(i)
        ii_text_ost = myWordfind3(arr_text_word1, UBound(arr_text_word1), jj_find, arr_Find_word, UBound(arr_Find_word), jj_text, s_percent).imyRows
        jj_text_ost = myWordfind3(arr_text_word1, UBound(arr_text_word1), jj_find, arr_Find_word, UBound(arr_Find_word), jj_text, s_percent).imyColumns
        ReDim text_word3(1 To ii_text_ost, 1 To jj_text_ost + 1) 'место ошибки
        On Error Resume Next: Err.Clear
        text_word3 = myWordfind3(arr_text_word1, UBound(arr_text_word1), jj_find, arr_Find_word, UBound(arr_Find_word), jj_text, s_percent).iFindword
        txt_row = txt_row + my_row
        
        'вставка итогового массива
        il = jj_text_ost + Int(Columns(txt_col).Column)
        txt_out = txt_col & txt_row & ":" & Trim(Substring(Cells(1, il).Address, "$", 2)) & Trim(Str(((ii_text_ost) + txt_row - 1)))
        
        ActiveWorkbook.Sheets(txt_p).Range(txt_out).Clear
        Set theRange_out = ActiveWorkbook.Sheets(txt_p).Range(txt_out)
        theRange_out = text_word3
        my_row = ii_text_ost 'шаг вывода ( считаем коородинаты выведения каждой части )
    Next j
    Next i

    
'динамический расчёт вставляемого массива от заданной ячейки полбзователем


    End If
    End If
End If
    
Application.ScreenUpdating = True

s_percent = CDbl((Me.TextBox4.Value))