在 sheet1 和 sheet2 中搜索相同的值并将值从 sheet1 复制到 sheet2

Question

我一直在使用 excel，但不太擅长 VBA，所以我需要帮助来制作宏，但我无法让录制宏工作:(

我有一个包含 2 张工作表（Sheet1 和 Sheet2）的 excel 文件。

我想将 Sheet2（A 列）中的文本与 sheet1（B 列）进行比较，如果它在两张表中都找到相同的文本，那么我希望宏将 A、B、C 和 D 列从 sheet1 复制到sheet2 中的 B、C、D 和 E 列。

在工作表 1 中，我有超过 6000 行，所以我不想手动执行此操作或在 excel 中执行公式，我想要一个为我执行此操作的宏。

表格有标题，有人可以帮我吗？

Answer 1

我有点不清楚你想要做什么。这是我的解释：假设，对于工作表 1 上的 X 行 A 列中的值——如果你在工作表 2 的 Y 行 B 列中找到相应的值——你想从工作表 1 中复制 X 行上的单元格到 ABCD 列并将它们粘贴到第 2 行的 Y 列 BCD E 中。

如果正确，试试这个：

Sub copyCells()
    Dim wb As Workbook, firstWs As Worksheet, secondWs As Worksheet
    Dim matchIndex As Integer

    Set wb = ThisWorkbook
    Set firstWs = wb.Worksheets(1)
    Set secondWs = wb.Worksheets(2)

    Application.ScreenUpdating = False

    ' We'll start at i=2 to account for the header
    For i = 2 To firstWs.Range("A2:A6000").Rows.count
        On Error Resume Next
        ' MATCH will find the row number in sheet 2 - change the range specifications as needed
        matchIndex = Application.WorksheetFunction.Match(firstWs.Range("A" & i), secondWs.Range("B2:B6000"), 0)
        Err.Clear
        On Error GoTo 0

        ' MATCH will throw an error if it finds no results.
        ' Hence: if matchindex contains an error, do nothing.
        ' But if it doesn't contain an error, it must contain a row number - so we can proceed.
        If Not Application.WorksheetFunction.IsNA(matchIndex) Then
            secondWs.Range("B" & matchIndex).Value = firstWs.Range("A" & i).Value
            secondWs.Range("C" & matchIndex).Value = firstWs.Range("B" & i).Value
            secondWs.Range("D" & matchIndex).Value = firstWs.Range("C" & i).Value
            secondWs.Range("E" & matchIndex).Value = firstWs.Range("D" & i).Value    
        End If
    Next i

    Application.ScreenUpdating = True
End Sub