Excel Vba - Как копировать и вставлять совпавшие строки с одного листа ниже точно совпавших строк на другом листе

Question

Я новичок в Excel VBA.В этом макросе я пытаюсь сделать следующее:

У меня есть два листа, два столбца, лист1, столбец A, лист2, столбец A, оба имеют возможные совпадения в столбце A. Я пытаюсь найти все совпадениямежду двумя листами и скопируйте совпадающие целые строки из листа1 в точно ниже соответствующих строк в листе два с заголовком листа 1.

sheet1

Данные ----------- имя

012 ----------- AAA

022 ----------- BBB

033 ----------- CCC

Лист2

id ----------- адрес

012 ----------- NYC

021 ----------- Philly

033 ----------- CT

Результат

id ----------- адрес

012 ----------- NYC

Данные ----------- имя

012 ----------- AAA

021 ----------- Philly

033 -----------CT

Данные ----------- имя

033 ----------- CCC

Theкод у меня пока только копирование первой строки, понятия не имею как это исправить.

Sub oneMacro()
Dim lastrowone As Integer, lastrowtwo As Integer
lastrowone = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lastrowtwo = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lastrowone
    For j = 2 To lastrowtwo
        If Sheets("Sheet1").Cells(i, "A").Value = Sheets("Sheet2").Cells(j, "A").Value Then
            Sheets("Sheet1").Cells(i, "A").EntireRow.Copy
            Sheets("Sheet2").Cells(j, "A").Offset(1).Insert Shift:=xlDown
        End If
    Next j
Next i
End Sub

Answer 1

Есть пара проблем с вашим кодом.Во-первых, чтобы помочь вам узнать, как вы можете решить эту проблему ... Во-первых, вы захотите добавить несколько точек останова и настроить несколько часов.Но вы увидите, что ваши циклы вначале настроены безупречно, но не адаптируются должным образом при добавлении данных.

Практически ваш оператор цикла продолжает циклически повторяться до тех пор, пока вы не нажмете lastrowtwo, который сначала будет установлен длязначение 3 (на основе вашего примера выше).Вместо этого ваш код должен добавлять +1 каждый раз, когда вы находите истинный результат в переменной lastrowtwo.Я изменил ваш код ниже, чтобы преодолеть эту проблему.

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

Sub oneMacro()
Dim lastrowone, lastrowtwo As Long

lastrowone = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lastrowtwo = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrowone
    For j = 2 To lastrowtwo
        If Sheets("Sheet1").Cells(i, 1).Value = Sheets("Sheet2").Cells(j, 1).Value Then
            Sheets("Sheet1").Cells(i, 1).EntireRow.Copy
            Sheets("Sheet2").Cells(j, 1).Offset(1).Insert Shift:=xlDown
            j = j + 1 ' Modified = this must be added to overcome an issue with DOUBLE checking the newly inserted data
            lastrowtwo = lastrowtwo + 1 ' Modified = This is added to overcome an issue with not completing all rows
        End If
    Next j
Next i

End Sub