使用VBA，如何在定义的范围内搜索多个字符串？

Question

如果我在A列中有很长的文本列表，而在C列中有很短的单词列表，那么最好的方法是在A的每个单元格中搜索C中的任何单词，然后复制并粘贴这些单词匹配到B列？

到目前为止，我编写的代码如下

   Sub ListKeywordQualifier()

Dim Rng As Range
Dim Keyword As Range
Dim Chunk As Range
Dim x As Long

x = 1

While x <= 5000
Set Rng = Range("A" & x)
Set Chunk = Range("C1", "C100")

Application.ScreenUpdating = True
Range("D1").Value = x
If Application.WorksheetFunction.CountIf(Chunk, Rng) = 0 Then
x = x + 1

ElseIf Application.WorksheetFunction.CountIf(Chunk, Rng) = 1 Then
Rng.Copy
Rng.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,         SkipBlanks _
    :=False, Transpose:=False
x = x + 1

End If

Wend

End Sub

但是，这只会给我两者之间的精确匹配。 是否可以这样做，但是在C列中显示文本，而仅组成A列的一部分，从而触发复制/粘贴行？

谢谢

Answer 1

您的countif不能正常工作，因为它是一个工作表函数，要实现countif ...，您需要像WorksheetFunction.CountIf一样编写它。 仍然您的代码看起来不好，请尝试一下！

 Sub ListKeywordQualifier()

 Dim Rng(50) As String
 Dim Chunk(50) As String
 Dim i As Long
 i = 1

 '' Take a value From 3rd Column this works for 10 cells , 
 For i = 1 To 10
 Chunk(i) = Cells(i, 3)

  ''Search it in 1st Column in 10 cells
 For j = 1 To 10
   Rng(j) = Cells(j, 1)

 ''If it matches 

   If Chunk(i) = Rng(j) Then

''Then copy that value to Second Column

  Cells(i, 2).Value = Rng(j)

End If

Next j

Next i

End Sub

这只是给您一个想法，您仍然需要进行更改，谢谢

Answer 2

考虑：

Sub ListKeywordQualifier()
   Dim A As Range, C As Range, aa As Range, cc As Range
   Dim K As Long, va, vc, boo As Boolean
   Set A = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
   Set C = Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)
   K = 1

   For Each aa In A
      va = aa.Value
      boo = False
      For Each cc In C
         If InStr(1, va, cc.Value) > o Then boo = True
      Next cc
      If boo Then
         aa.Copy Cells(K, "B")
         K = K + 1
      End If
   Next aa
End Sub

之前：

之后：