VBA, чтобы найти совпадения между столбцом L на листе 1 и столбцом A на листе 2, затем вставьте строку, которая соответствует на листе 3

Dim ii As Long Dim j As Long Dim sheet1LastRow As Long Dim sheet2LastRow As Long sheet1LastRow = Worksheets("Final").Range("L" & Rows.Count).End(xlUp).Row sheet2LastRow = Worksheets("2015new").Range("A" & Rows.Count).End(xlUp).Row For j = 2 To sheet1LastRow For ii = 2 To sheet2LastRow If Worksheets("Final").Cells(j, 1).Value = Worksheets("2015new").Cells(ii, 1).Value Then Worksheets("2015new").Rows(ii & ":" & ii).Copy Sheets("Extract").Range("A65536").End(xlUp).Offset(1) Else End If Next ii Next j 

Просмотрел форумы и придумал коды выше, но он, похоже, не работает. Он также буферизуется на некоторое время, прежде чем возвращаться ни с чем. Любая помощь приветствуется. Некоторая дополнительная информация, обе колонки состоят из дат, и они не совпадают. (то есть в листе 1 есть около 100 строк дат, а у листа 2 – 20krows)

просто ищет скорость, что-то вроде этого должно многое помочь:

 Dim chkRng As Variant, runRng As Range, outRng As Range, i As Long chkRng = Worksheets("Final").Range("L1", Worksheets("Final").Range("L" & Rows.Count).End(xlUp)).Value For Each runRng In Worksheets("2015new").Range("A2", Worksheets("2015new").Range("A" & Rows.Count).End(xlUp)) For i = 2 To UBound(chkRng) If chkRng(i, 1) = runRng.Value Then If outRng Is Nothing Then Set outRng = runRng.EntireRow Else Set outRng = Union(outRng, runRng.EntireRow) Exit For End If Next Next If Not outRng Is Nothing Then outRng.Copy Sheets("Extract").Range("A65536").End(xlUp).Offset(1) 

Я внес некоторые изменения в ваш код, надеюсь, что это поможет. (Не испытано)

 Dim ii As Long Dim j As Long Dim sheet1LastRow As Long Dim sheet2LastRow As Long sheet1LastRow = Worksheets("Final").Range("L" & Rows.Count).End(xlUp).Row sheet2LastRow = Worksheets("2015new").Range("A" & Rows.Count).End(xlUp).Row For j = 2 To sheet1LastRow For ii = 2 To sheet2LastRow If Worksheets("Final").Cells(j, 1).Value = Worksheets("2015new").Cells(ii, 1).Value Then Worksheets("2015new").Rows(ii).Copy Sheets("Extract").Range("A65536").End(xlUp).Offset(1,0) Else End If Next ii Next j 
Давайте будем гением компьютера.