從Sheet2查找名稱並將行復制到Sheet3

Question

我目前有3張紙。 表格1包含12列。 第一列是公司名稱，我使用sheet2和公司名稱列表來查找工作表1列A。

我是用VLOOKUP完成的

    =IFERROR(VLOOKUP($A2,Sheet1!$A:$L,COLUMNS($B2:B2)+1,0),"")

此方法有效，但是公司名稱在工作表1中多次出現。

每當出現該行時，我將如何復制？

我為VBA解決方案感到高興。

Answer 1

某些效果應該起作用。 我不知道所有列是否都與您的工作簿中的列相同，並且截至目前，如果工作表3上沒有標題，那么該工作表上的第一行將為空白。 除此之外，這似乎可行。

Public Sub findMatch()
    Dim lastRowS1 As Long, lastRowS2 As Long, lastRowS3 As Long, i As Long, j As Long
    Dim tempS1 As String, temps2 As String
    lastRowS1 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    lastRowS2 = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row

    Application.ScreenUpdating = False

    For i = 1 To lastRowS1
        tempS1 = Sheet1.Cells(i, 1).Text
        For j = 1 To lastRowS2
            temps2 = Sheet2.Cells(j, 1).Text
            If tempS1 = temps2 Then
                lastRowS3 = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
                Sheet1.Rows(i).EntireRow.Copy Destination:=Sheet3.Rows(lastRowS3 + 1)
                j = lastRowS2
            End If
        Next j
    Next i

    Application.ScreenUpdating = True


End Sub

試試這個家伙：

Public Sub findMatch()
    Dim lastRowS1 As Long, lastRowS2 As Long, lastRowS3 As Long, i As Long, j As Long
    Dim tempS1 As String, tempS2 As String, tempRow As Long
    lastRowS1 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    lastRowS2 = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row

    Application.ScreenUpdating = False

    For i = 1 To lastRowS1
        tempS1 = Sheet1.Cells(i, 1).Text

        If Not IsError(Application.Match(tempS1, Sheet2.Range("A:A"), 0)) Then
            lastRowS3 = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
            Sheet1.Rows(i).EntireRow.Copy Destination:=Sheet3.Rows(lastRowS3 + 1)

        End If

    Next i

    Application.ScreenUpdating = True

End Sub

編輯：忘記刪除Debug.Print也將加快速度。

Answer 2

我建議您在此線程中查看Siddharth Rout的答案。 它與您想要的大致相似。 簡而言之，您將遍歷工作表2上的公司名稱，並使用Siddharth描述的“查找”功能在工作表1上找到匹配的行，然后將其移動到工作表3上填充區域的底部。

您的需要稍有不同，因為您要實際移動內容，但是只需使用Macro Recorder（在默認情況下可能需要打開的處於隱藏狀態的Developer選項卡上）將為您提供執行移動的VBA語法。