После матча определите новую характеристику

Question

У меня есть два листа, которые я хочу соединить.Характеристики соединения можно найти в листе «Тип» в столбце А и в листе «Данные» в столбце J.

Существует ли вероятность того, что после обнаружения совпадения новая характеристика будетопределяется в листе «Данные» в столбце B тем же процессом?

Поскольку мой английский не самый лучший, вот иллюстрация того, что я хочу сделать в листе «Данные»:

совпадение найдено в столбце J:

В столбце B теперь указывается, что значение обновляется в столбце L .:

Sub test()

lastrow = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
lastRow2 = Worksheets("Type").Cells(Rows.Count, 1).End(xlUp).Row


Set sh = Sheets("Data")
Set sb = Sheets("Type")

With sh

For j = 2 To lastrow
found = False
    i = 2
    Do Until i = lastRow2
            If Sheets("Data").Range("J" & j).Value = Sheets("Type").Range("A" & i).Value Then

'Something should happen here

            Sheets("Data").Range("L" & j).Value = Sheets("Type").Range("D" & i).Value
        End If
        i = i + 1
    Loop

Next j
End With

End Sub

Есть ли способ выполнить этофункция без дополнительного вспомогательного столбца?

Альтернативой может быть запуск Vlookup с листа «Данные» на лист «Тип»:

Данные листа до:

Тип листа до:

Тип листа после того, как я использую VLOOKUP и вставляю столбец B, основываясь на выводах в столбце J:

Данные листа после запуска следующегокод ниже, чтобы сопоставить новый столбец E в «Type» с Coстолбец B в разделе «Данные» для вставки значений из столбца D (лист «Тип») в столбец L в данных листа:

Код для последнего шага будет выглядеть следующим образом:

lastrow = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
lastRow2 = Worksheets("Type").Cells(Rows.Count, 1).End(xlUp).Row


Set sh = Sheets("Data")
Set sb = Sheets("Type")

With sh

For j = 2 To lastrow

    i = 2
    Do Until i = lastRow2
    If Sheets("Data").Range("B" & j).Value = Sheets("Type").Range("E" & i).Value Then
            Sheets("Data").Range("L" & j).Value = Sheets("Type").Range("D" & i).Value
        End If
        i = i + 1
    Loop

Next j
End With

Есть ли какой-нибудь способ избежать Vlookup заранее, чтобы улучшить производительность?