查找匹配项，从Sheet1复制行并将其插入Sheet2 [英] Find Match, Copy Row from Sheet1 and Insert Into Sheet2

问题描述

在Sheet1中，我大约有10,000行代表不同的人.每个人在D列中都有一个唯一的ID，该ID是存储为文本的数字序列.

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.

在Sheet2中，我大约有1200个人条目，这些条目在A列中引用了Sheet1中的匹配人员.此引用与Sheet1中使用的唯一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.

我想要做一个宏是这样的:

What I would like is to have a macro do is this:

• 在Sheet2上读取单元格A1的值
• 在Sheet1的D列中找到匹配的值
• 复制Sheet1中的匹配行
• 在Sheet2(第2行)下方插入匹配的行

• 插入空白行(第3行)

• 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)

重复Sheet2上其余9,999个条目的步骤，以使匹配的数据始终位于读入值以下，然后是空白行

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

任何帮助将不胜感激.

推荐答案

请告诉我，将来您会显示出尝试解决所遇到问题的证据.这样，我们知道您正在加入社区，而不是试图从中汲取自由劳动.

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.

这是您可以尝试的解决方案.它从sheet2中当前选定的单元格开始.

Here is a solution you can try. It starts from the currently selected cell in 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

这篇关于查找匹配项，从Sheet1复制行并将其插入Sheet2的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！