vba 查找匹配项，从 Sheet1 复制行并插入到 Sheet2
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/4806170/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Find Match, Copy Row from Sheet1 and Insert Into Sheet2
提问by anticedent
In Sheet1, I have around 10,000 rows representing different people. Each person has a unique ID located in column D, which is a number sequence stored as text.
在 Sheet1 中，我有大约 10,000 行代表不同的人。每个人都有一个位于 D 列的唯一 ID，它是一个以文本形式存储的数字序列。
In Sheet2, I have around 1,200 person entries that have have a reference to a matching person in Sheet1 located in column A. This reference is the same unique ID used in Sheet1.
在 Sheet2 中，我有大约 1,200 个个人条目，这些条目引用了位于 A 列的 Sheet1 中的匹配人员。此引用与 Sheet1 中使用的唯一 ID 相同。
What I would like is to have a macro do is this:
我想要的是让一个宏做的是：
- read-in the value of cell A1 on Sheet2
- find the matching value in column D on Sheet1
- copy the matching row in Sheet1
- insert the matching row underneath on Sheet2 (row 2)
insert a blank row (row 3)
repeat the steps for the remaining 9,999 entries on Sheet2 so that the matching data always falls underneath the read-in value, followed by a blank row
- 读入 Sheet2 上单元格 A1 的值
- 在 Sheet1 的 D 列中找到匹配的值
- 复制 Sheet1 中的匹配行
- 在 Sheet2 下方插入匹配的行（第 2 行）
插入一个空行（第 3 行）
对 Sheet2 上剩余的 9,999 个条目重复这些步骤，以便匹配的数据始终低于读入值，后跟一个空白行
Any help would be appreciated.
任何帮助，将不胜感激。
回答by Kevin A. Naudé
May I advise that in future you show evidence of trying to solve the problem you are having. That way we know you are participating in the community and not attempting to extract free labour from it.
我可以建议您将来展示尝试解决您遇到的问题的证据。这样我们就知道您是在参与社区，而不是试图从中榨取免费劳动力。
Here is a solution you can try. It starts from the currently selected cell in sheet2.
这是您可以尝试的解决方案。它从 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
