VBA 使用另一张表中列表中的单词搜索 C 列，然后将相关单词粘贴到 L 列中的每一行

Question

这里的菜鸟对 VBA 的了解很少，试图让我的一张工作表工作。我的搜索使我了解了几乎所有其他内容，如果我更多地了解 vba 语言，我也许可以修改代码以满足我的需要。首先我会解释我想要什么，然后解释我到目前为止所做的事情：

我想要什么- 我有一张表，其中某些列合并在某些行中（当列表中有新供应商时，该行有时会合并到 J，有时会合并到 L），我希望在 C 列中查看是否出现单词在另一张纸的列表中（以便其他人将来添加到列表中），如果有，那么我希望将搜索到的单词（来自另一张纸）输入到 K 列中。

这是我需要搜索的一些单词的列表： 紧迫的 被追赶， 追逐， 沉重、追逐 逾期

这是我拥有的数据示例

A	B	C	D	E	F	G	H	我	J	K
供应商1
		（紧急）12345
		(DD)12345
		（追）12345
供应商2
		（紧急）23-PM1688-12345
		(追)4632890336-mYNU
		98765
		987654
		（重追）AB
		（chk笔记）至尊
供应商3
		飞机
		（逾期）洞穴出租
		（紧急）篮子 04/2024

因此宏需要搜索 C 列，然后如果它从另一张表中找到一个单词，则将该单词粘贴到 K 列中。其他列中有数据，并且某些列被合并。

到目前为止我所拥有的

通过搜索，我找到了一个我已经操作过的宏，但我只是无法让它工作，它将搜索列表并查找找到该单词的次数并将其粘贴到 K 中，但按照它显示的顺序在列表中而不是在数据所在的同一行中：

Sub Comments()

Dim FoundCell As Range

Dim LastCell As Range

Dim FirstAddr As String

Dim myRange1 As Range

Dim myRange2 As Range

Dim myRange3 As Range

Dim myCell1 As Range

Dim myCell2 As Range

Dim myStr As String

Dim myCounter As Long

SetmyRange1 = ActiveSheet.Range("C:C") 'Cells where you want to search

Set myRange2 = Worksheets("Sheet6").Range("K3") 'First cell of the output list

Set myRange3 = Worksheets("Words").Range("A:A") 'Cells that contain the words we're searching

With myRange1 '(Cells where you want to search)

Set LastCell = .Cells(.Cells.Count)

End With

For Each myCell1 In myRange3 '(Cells that contain the words we're searching)

Set FoundCell = myRange1.Find(What:=myCell1, after:=LastCell)

If Not FoundCell Is Nothing Then FirstAddr = FoundCell.Address

Do Until FoundCell Is Nothing

For Each myCell2 In myRange3

Next myCell2

With myRange2 '(First cell of the output list)

.Offset(myCounter, 1) = myCell1

.Offset(myCounter, 0) = FoundCell.Offset(0, -2)

.Offset(myCounter, 2) = myStr

End With

myStr = vbNullString

myCounter = myCounter + 1

Set FoundCell = myRange1.FindNext(after:=FoundCell)

If FoundCell.Address = FirstAddr Then

Exit Do

End If

Loop

Next myCell1

End Sub

Answer 1

请。试试这个模组。 "（仅供参考：合并不允许将值分配到合并范围左� 755e ��角以外的其他单元格中。）K 列不能包含任一方向的合并单元格。

\n"

Sub Comment()
    Dim FoundCell   As Range
    Dim LastCell    As Range
    Dim FirstAddr   As String
    Dim myRange1    As Range
    Dim myRange2    As Range
    Dim myRange3    As Range
    Dim myCell1     As Range
    Dim myCell2     As Range
    Dim myStr       As String
    Dim myCounter   As Long
    Set myRange1 = ActiveSheet.Range("C:C")        'Cells where you want to search
    'Set myRange2 = Worksheets("Sheet6").Range("K3")        'First cell of the output list
    Set myRange3 = Worksheets("Words").Range("A1:A" & Worksheets("Words").Range("A1").End(xlDown).Row) 'Cells that contain the words we're searching
    'With myRange1        '(Cells where you want to search)
    '    Set LastCell = .Cells(.Cells.Count)
    'End With
    For Each myCell1 In myRange3        '(Cells that contain the words we're searching)
        Set FoundCell = myRange1.Find(What:=myCell1) ', after:=LastCell)
        If Not FoundCell Is Nothing Then FirstAddr = FoundCell.Address
        Do Until FoundCell Is Nothing
            
            'For Each myCell2 In myRange3
            'Next myCell2
            'With myRange2        '(First cell of the output list)
            '    .Offset(myCounter, 1) = myCell1
            '    .Offset(myCounter, 0) = FoundCell.Offset(0, -2)
            '    .Offset(myCounter, 2) = myStr
            'End With
            myRange1.Parent.Cells(FoundCell.Row, "K") = myCell1 & ", " & myRange1.Parent.Cells(FoundCell.Row, "K")       'inserted
            'myStr = vbNullString
            'myCounter = myCounter + 1
            Set FoundCell = myRange1.FindNext(after:=FoundCell)
            If FoundCell.Address = FirstAddr Then
              Exit Do
            End If
        Loop
    Next myCell1
End Sub

编辑 我试图留下你的代码结构。 myRange3 被缩小到列的实际大小。它要求“单词”表上 A 列中要搜索的值之间不能有空单元格。

必要的一行在错误的位置被注释掉了。

找到的单词放置在与查找列所在的同一工作表的 K 列中。