查找匹配，从 Sheet1 复制行并插入到 Sheet2答案

【问题标题】：Find Match, Copy Row from Sheet1 and Insert Into Sheet2查找匹配，从 Sheet1 复制行并插入到 Sheet2
【发布时间】：2011-01-26 15:14:50
【问题描述】：

在 Sheet1 中，我有大约 10,000 行代表不同的人。每个人都有一个位于 D 列的唯一 ID，这是一个以文本形式存储的数字序列。

在 Sheet2 中，我有大约 1,200 个人员条目，这些条目引用了位于 A 列的 Sheet1 中的匹配人员。此引用与 Sheet1 中使用的唯一 ID 相同。

我想要一个宏做的是：

读入Sheet2上A1单元格的值
在 Sheet1 的 D 列中查找匹配值
复制 Sheet1 中的匹配行
在 Sheet2（第 2 行）下方插入匹配行
插入一个空白行（第 3 行）
对 Sheet2 上剩余的 9,999 个条目重复这些步骤，以使匹配的数据始终低于读入值，然后是空白行

任何帮助将不胜感激。

【问题讨论】：

标签： excel excel-2007 vba

【解决方案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

【讨论】：

@Kevin：首先，感谢您的时间和帮助 - 宏完全按照我希望的方式执行。其次，我很抱歉没有包括我最初的努力。我的目的不是依靠社区的努力，而是学习正确的技术和解决问题的不同方法。再次发布时，我一定会牢记您的建议。再次，非常感谢。
@anticedent：很高兴我能帮上忙。