Найти соответствие, скопировать строку из листа 1 и вставить в лист 2

Question

В Sheet1 у меня около 10000 строк, представляющих разных людей. Каждый человек имеет уникальный идентификатор, расположенный в столбце D, который представляет собой числовую последовательность, хранящуюся в виде текста.

В Sheet2 у меня есть около 1200 записей о людях, которые имеют ссылку на соответствующего человека в Sheet1, расположенном в столбце A. Эта ссылка является тем же уникальным идентификатором, который используется в Sheet1.

Я хотел бы, чтобы макрос делал вот что:

• считывание значения ячейки A1 на листе 2
• найти соответствующее значение в столбце D на листе 1
• скопировать соответствующую строку в Лист1
• вставить соответствующую строку внизу на Листе 2 (строка 2)

• вставить пустую строку (строка 3)

• повторите шаги для оставшихся 9 999 записей на Листе 2, чтобы совпадающие данные всегда попадали ниже значения для чтения, за которым следует пустая строка

Буду признателен за любую помощь.

Answer 1

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

Вот решение, которое вы можете попробовать. Он начинается с текущей выбранной ячейки в sheet2.

Function DoOne(RowIndex As Integer) As Boolean
    Dim Key
    Dim Target
    Dim Success
    Success = False
    If Not IsEmpty(Cells(RowIndex, 1).Value) Then
        Key = Cells(RowIndex, 1).Value

        Sheets("Sheet1").Select

        Set Target = Columns(4).Find(Key, LookIn:=xlValues)

        If Not Target Is Nothing Then
            Rows(Target.row).Select
            Selection.Copy
            Sheets("Sheet2").Select
            Rows(RowIndex + 1).Select
            Selection.Insert Shift:=xlDown
            Rows(RowIndex + 2).Select
            Application.CutCopyMode = False
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Cells(RowIndex + 3, 1).Select
            Success = True
        End If

    End If
    DoOne = Success
End Function

Sub TheMacro()
    Dim RowIndex As Integer
    Sheets("Sheet2").Select
    RowIndex = Cells.row
    While DoOne(RowIndex)
        RowIndex = RowIndex + 3
    Wend
End Sub