Question

我在excel vba场景中还很新。我在此宏中要完成的工作是

我有两张纸，两列，sheet1的A列，sheet2的A列，在A列中都有可能的匹配项。我试图找到两张纸之间的所有匹配项，并将匹配的整个行从sheet1复制到恰好在匹配的行下面在工作表2中，其标题为sheet1。

sheet1

数据-----------名称

012 ----------- AAA

022 ----------- BBB

033 ----------- CCC

Sheet2

id -----------地址

012 ----------- NYC

021 -----------菲利

033 ----------- CT

结果

id -----------地址

012 ----------- NYC

数据-----------名称

012 ----------- AAA

021 -----------菲利

033 ----------- CT

数据-----------名称

033 ----------- CCC

到目前为止，我拥有的代码仅复制第一行，不知道如何解决。

Sub oneMacro()
Dim lastrowone As Integer, lastrowtwo As Integer
lastrowone = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lastrowtwo = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lastrowone
    For j = 2 To lastrowtwo
        If Sheets("Sheet1").Cells(i, "A").Value = Sheets("Sheet2").Cells(j, "A").Value Then
            Sheets("Sheet1").Cells(i, "A").EntireRow.Copy
            Sheets("Sheet2").Cells(j, "A").Offset(1).Insert Shift:=xlDown
        End If
    Next j
Next i
End Sub

Answer 1

您的代码有两个问题。首先，为了帮助您了解如何解决此问题...首先，您需要添加一些断点，并设置一些手表。但是您会看到循环一开始是完全正确设置的，但是在添加数据时无法正确适应。

几乎您的循环语句继续循环，直到您的命中lastrowtwo最初设置为3（基于上述示例）。每次找到+1变量的真实结果时，您的代码都需要添加lastrowtwo。我已经在下面修改了您的代码以解决此问题。

另一个问题是您正在处理从一个单元格到另一个单元格的所有内容，然后将其向下移动。这样做时，您将比较下一个（作为匹配项返回）。片刻之后，您会看到这只会扫描第一个订单项。为了克服这个问题，您可以简单地跳过循环检查语句中的下一行。您可以通过将+1添加到j变量中来实现。修改见下文。

Sub oneMacro()
Dim lastrowone, lastrowtwo As Long

lastrowone = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lastrowtwo = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrowone
    For j = 2 To lastrowtwo
        If Sheets("Sheet1").Cells(i, 1).Value = Sheets("Sheet2").Cells(j, 1).Value Then
            Sheets("Sheet1").Cells(i, 1).EntireRow.Copy
            Sheets("Sheet2").Cells(j, 1).Offset(1).Insert Shift:=xlDown
            j = j + 1 ' Modified = this must be added to overcome an issue with DOUBLE checking the newly inserted data
            lastrowtwo = lastrowtwo + 1 ' Modified = This is added to overcome an issue with not completing all rows
        End If
    Next j
Next i

End Sub

Excel Vba-如何将匹配的行从一个工作表复制并粘贴到另一工作表中的完全匹配的行以下

1 个答案: