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

В Sheet1 имам около 10 000 реда, представляващи различни хора. Всеки човек има уникален идентификатор, намиращ се в колона D, която е числова последователност, съхранена като текст.

В Sheet2 имам около 1200 записа за лица, които имат препратка към съответстващо лице в Sheet1, намиращо се в колона A. Тази препратка е същият уникален идентификатор, използван в Sheet1.

Това, което бих искал е да направя макрос, е следното:

  • прочетете стойността на клетка A1 на Sheet2
  • намерете съответстващата стойност в колона D на Sheet1
  • копирайте съвпадащия ред в Sheet1
  • вмъкнете съвпадащия ред отдолу на Sheet2 (ред 2)

  • вмъкнете празен ред (ред 3)

  • повторете стъпките за останалите 9999 записа на Sheet2, така че съвпадащите данни винаги да попадат под прочетената стойност, последвана от празен ред

Всяка помощ ще бъде оценена.


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

Отговори (1)


arrow_upward
2
arrow_downward

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

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