совпадение двух массивов и возвращает адрес ячейки матча затем скопировать следующий столбец этой ячейки

Question

В одном Таблицах,

• я в значениях Колонка A от 1 до 10, они разделены на три пустых строк , означает значение 1 в A1, значение2 в A4 и так далее.
• В столбце B у меня есть номера, но в произвольном порядке, но они находятся в пределах диапазона в столбце A, это означает, что если максимальное значение в столбце A равно 15, любое значение в диапазоне B никогда не будет превышать 15, а значения в B размещены в тех же строках, что и значения A.
• В столбце C у меня есть значения для каждого номера в диапазоне B, у меня есть 4 ответа. поэтому для первого значения в B1 i есть C1, C2, C3, C4 и т. д.

Теперь, что я хочу сделать, я хочу совместить значения в столбце B с A, а затем скопировать четыре значения C и вставить затем в D, где найдено значение соответствия.

например, если у меня есть 5 в качестве первого значения в столбце B, я хочу проверить, где это значение находится в столбце A, затем скопируйте C1, C2, C3, C4 и вставьте их перед столбцом 5 в столбце A Я хочу для этого используйте Массивы.

Я уже написал макрос, чтобы сделать это с помощью функции loop и match, но это не очень практично, так как у меня есть много файлов для прокрутки и длинных столбцов A и B, так что это требует времени и имеет много других ограничений, Итак, есть ли другой способ достичь этой цели, например, с помощью массивов? и если я использовал два массива для диапазонов A и диапазона B, как я могу использовать функцию соответствия или блокировку для их сравнения? это мой макрос:

Dim see As Worksheet 
Set see = ThisWorkbook.Sheets("Sheet2") 
Dim rega As Range 
Dim numb As Long 
Dim tr As Integer 
Dim dd As Long 
With see 
    Set rega = .Range(.Cells(3, gh + 2).Address, .Cells(23, gh + 2).Address) 
End With 
For tr = 3 To 40 Step 4 
    numb = M.Application.WorksheetFunction.Match(see.Cells(tr, 1 + gh), rega, 0) 
    For dd = 0 To 3 
     see.Cells(numb + dd, gh + 3).Copy 
     see.Cells(te + dd, gh + 4).PasteSpecial 
    Next dd 
Next 

Answer 1

Вы можете избавиться, по крайней мере, одну петлю и преобразовать Copy, Paste Special для прямой передачи значения.

With see 
    Set rega = .Range(.Cells(3, gh + 2).Address, .Cells(23, gh + 2).Address) 
    For tr = 3 To 40 Step 4 
     numb = M.Application.Match(.Cells(tr, 1 + gh), rega, 0) 
     .Cells(tr, gh + 4).resize(4, 1) = .Cells(numb, gh + 3).resize(4, 1).value 
    Next tr 
End With 

... вместо того, чтобы,

With see 
    Set rega = .Range(.Cells(3, gh + 2).Address, .Cells(23, gh + 2).Address) 
End With 
For tr = 3 To 40 Step 4 
    numb = M.Application.WorksheetFunction.Match(see.Cells(tr, 1 + gh), rega, 0) 
    For dd = 0 To 3 
     see.Cells(numb + dd, gh + 3).Copy 
     see.Cells(te + dd, gh + 4).PasteSpecial 
    Next dd 
Next 

(я предположил, опечатка и изменил see.Cells(te, gh + 4) на see.Cells(tr, gh + 4))

Кроме того, я не так много, чтобы рекомендовать, кроме выключения события, расчет и обновление экрана.

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 
Application.EnableEvents = False 

' run all the code 

Application.EnableEvents = True 
Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True