Вылет программы при использовании макроса

[Hugo121]

"Доступ к значению по ключу."

x.Item(a(i, 1))
Цикл по получателю a()
if x.exists(a(i,1) then a(i,2).value=x.Item(a(i, 1))

[SAS888]

У словаря нет индексов. Это пары "ключ - значение". Используйте массивы (см. пост №47 от Hugo121)
Также, вместо словаря можно использовать коллекцию, доступ к значениям которой возможен как по ключу, так и по индексу.

[SaLoKiN]

Т.е. используя словарь я не смогу после склейки обращаться к ключу для его дальнейшего сравнения?

[SAS888]

Вы же "склеивать" будете не ключ, а значение...

[SaLoKiN]

Да, но мне нужно значение ключа для правильной подставновки в таблицу

[Hugo121]

Нужно - берите. Что ещё сказать без примера
P.S. А, есть что сказать - есть UDF VLOOKUPCOUPLE() - поищите. Думаю как раз что нужно.

[SAS888]

Используйте метод ".keys" и в цикле перебирайте ключи.
А еще лучше, объясните подробнее, что Вам требуется.

[SaLoKiN]

А еще лучше, объясните подробнее, что Вам требуется.

Давайте! На листе имеются две таблицы(верхняя таблица содержит данные по маршрутам, какой магазин попадает в какой маршрут и порядок разгрузки по магазинам.Нижняя таблица содержит номер маршрута и номер авто который поедет по этому маршруту)
В нижнюю таблицу по номеру маршрута нужно сформировать список магазинов по загрузке(т.е. порядок обратный разгрузке).
Чтобы забив верхнюю таблицу,выбрав диапазон(чтобы вся нижняя не перерасчитывалась)и нажав кнопку сформировалась очередь магазинов.

Алгоритм таков:
-Выбор диапазона
-сборочка массива
-сортировка(наверно нужна,потому что иначе очередь формируется по мере нахождения маршрута)
-склейка
-вывод в нужную строку таблицы нужной строки склейки

Приложил файл. Лист про который я писал это НТК1.
Лист 1 и лист 2 это то где я сейчас мучаю все это дело.
Макрос RunMe() работает как нужно, лист l5 не интересен.
Лист сцепка это для старого метода формирования очереди(используя Sub Очередь()).
Sub Testing() это то,в чем я сейчас копаюсь.

P.S. Вот это рабочий Sub Testing(), который может сформировать на Лист 1 таблицу, из которой нужна склейка.

Sub Testing()

Dim НТК As Worksheet
Dim Сцепка As Worksheet
Set Сцепка = ActiveWorkbook.Worksheets("Сцепка")
Set НТК = ActiveWorkbook.Worksheets("НТК 1 ")

Dim Zx As Integer, Zy As Integer, Str1 As Integer, Str2 As Integer
Dim x As Integer, y As Integer, x1 As Integer, y1 As Integer
Dim i As Long, S As Long, j As Long, iLastRow As Long, ii As Long

Dim a, b, Strok

Application.ScreenUpdating = False





Zx = -1 ' сдвиг по столбцу
Zy = -93 ' по строке
Str1 = 99 ' строки.
Str2 = 144 ' строки.


x = Selection.Column ' чисто для
y = Selection.Row    ' координаты
' конечные координаты
x1 = x + Selection.Columns.Count - 1
y1 = y + Selection.Rows.Count - 1

' Сцепка.Range(Selection.Offset(Zy, Zx).AddressLocal).Copy
 '   With НТК
  '   .Range(.Cells(y, x1).AddressLocal).PasteSpecial Paste:=xlPasteValues
   ' End With
    

'If (x = 10) And (x1 = 10) Then     ' проверка границ выбора
'    If y >= Str1 And y1 <= Str2 Then ' проверка границ выбора
    
    
'загрузить массив а значениями А3 J96
With Sheets("НТК 1 ")
iLastRow = 98 'грубая прявязка к адресу ЮЗАТЬ РЕГИОН
a = НТК.Range(.Cells(3, 1), .Cells(iLastRow, 12)) ' загрузили массив А3 J96
End With

' создали массив  B для результата
ReDim b(1 To UBound(a, 1), 1 To 12)


j = 1  ' нижняя часть таблицы

For ii = 99 To 144 'грубая прявязка к адресу


'подгрузили условия
    With Sheets("НТК 1 ")
    compared1 = .Cells(ii, 4) ' marshrut
    compared2 = .Cells(ii, 6) ' nomer avto
    compared4 = 1 ' svoi mashini
    End With

'начинаем поиск
    For i = 1 To UBound(a) ' 96 грубая прявязка к адресу

        If a(i, 8) = compared1 Then
            If (a(i, 11) = 1) Or (a(i, 11) = 2) Then
                b(j, 1) = compared1 'marshrut
                b(j, 2) = a(i, 1) 'Nomer magazina
                b(j, 3) = a(i, 10) 'poryadok razgruzki
                j = j + 1
            End If
        End If

Next

' выгрузка масссива
If j > 0 Then
ThisWorkbook.ActiveSheet.Range(Cells(3, 1), Cells(j + 2, 10)) = b
End If


Next

    
b = ThisWorkbook.ActiveSheet.Range(Cells(3, 1), Cells(j + 2, 10))



 'Сортирнули
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Add Key:=Range("A3:A69"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Add Key:=Range("C3:C69"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Лист1").Sort
        .SetRange Range("A3:C69")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
  
  
  
  
 
   ' Else: MsgBox ("Неверный диаппазон по строке!Нужный адрес ячеек J99:J144")
   ' End If
'Else: MsgBox ("Неверный диаппазон по столбцу!Нужный адрес ячеек J99:J144")
'End If

      
    'ThisWorkbook.ActiveSheet.Range(Cells(3, 1), Cells(j + 2, 10))
        
End Sub

[Hugo121]

СцепитьЕсли() уже в работе - тогда другая аналогичная UDF уже не нужна

[Hugo121]

Хотя почему не используете UDF?
Например вот в J99:

=VLOOKUPCOUPLE($A$3:$J$95,8,D99,1,";")