excel - 如何识别 A 列 Sheet1 中与 B 列中的单词匹配的单词，然后将这些行复制到 Sheet2？

Question

我将 1 到 30+ 个不同的单词粘贴到 A 列 Sheet1 中(每个单元格一个单词)。

代码必须遍历 A 列和 B 列(以查看 A 列中的单词是否与 B 列中的单词匹配)。
B 列填充了数千个不同的单词(每个单元格一个单词)。

当 B 列中的单词与 A 列中的单词匹配时，B 列中匹配单词的行将复制到 Sheet2 中。

Sheet2 与 Sheet1 具有相同的标题(可能有 25+ 个不同的列标题)，因此复制到 Sheet2 的行将对齐。
我需要每次在 A 列中使用不同的单词重复此过程。 Value = "NAME"为一个词工作:

Private Sub CommandButton1_Click()
    a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    For I = 5 To a
    
        If Worksheets("Sheet1").Cells(I, 1).Value = "NAME" Then
    
            Worksheets("Sheet1").Rows(I).Copy
    
            Worksheets("Sheet2").Activate
            b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
            Worksheets("Sheet2").Cells(b + 1, 1).Select
            ActiveSheet.Paste
            Worksheets("Sheet1").Activate
    
        End If
    Next
    
    Application.CutCopyMode = False
    
    ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Select
    
End Sub

Answer 1

代码将循环通过 Sheet1 ColumnA 以获取搜索词，然后循环通过 Sheet1 ColumnB 以测试匹配，如果匹配，则将行复制到 Sheet2。

Private Sub CommandButton1_Click()
Dim a As Integer, b As Integer, i As Integer, j As Integer
With Worksheets("Sheet1")
    .Activate
    .Cells(1, 1).Select
    a = .Cells(Rows.Count, 1).End(xlUp).Row
    b = .Cells(Rows.Count, 2).End(xlUp).Row
    For i = 5 To a
        For j = 5 To b
            If .Cells(j, 2).Value = .Cells(i, 1).Value Then 
                .Rows(j).Copy Worksheets("Sheet2").Rows(Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row + 1)
            End If
        Next
    Next
End With
End Sub

此版本的代码不会在工作表上物理“跳跃”。

该代码将仅找到完全匹配。如果需要在字符串中查找字符串，请使用 LIKE 和通配符或 InStr() 函数，例如: If .Cells(j, 2).Value LIKE "*" & .Cells(i, 1).Value & "*" Then
请注意，我的测试显示此代码区分大小写:Apple <> apple。