使用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

之前：

之后：