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

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

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

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

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

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

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

Любая помощь будет оценена.


excel vba excel-2007
person anticedent    schedule 26.01.2011    source источник

Ответы (1)


arrow_upward
2
arrow_downward

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

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

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
person Kevin A. Naudé    schedule 26.01.2011
comment
@ Кевин: Во-первых, спасибо за ваше время и помощь - макрос работает именно так, как я надеялся. Во-вторых, я прошу прощения за то, что не включил свои первоначальные усилия. Я не собираюсь использовать усилия сообщества, а скорее хочу изучить правильные методы и различные подходы к решению проблем. Я обязательно учту ваш совет при повторной публикации. Еще раз большое спасибо. - person anticedent; 26.01.2011
comment
@anticedent: Рад, что смог помочь. - person Kevin A. Naudé; 27.01.2011