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

本文介绍了使用VBA，如何在定义的范围内搜索多个字符串？的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述 如果我在列A中有很长的文本列表，以及列C中的简短的单词列表，那么最好的办法是在A中为C中的任何单词搜索每个单元格，并复制和将匹配的列表粘贴到列B中？

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

Sub ListKeywordQualifier（） Dim Rng As Range Dim关键字作为范围 Dim Chunk As Range Dim x As Long x = 1 虽然x <= 5000 设置Rng =范围（A& x）设置块=范围（C1 ，C100） Application.ScreenUpdating = True Range（D1）。Value = x 如果Application.WorksheetFunction.CountIf（Chunk，Rng）= 0然后x = x + 1 ElseIf Application.WorksheetFunction.CountIf（Chunk，Rng）= 1然后 Rng.Copy Rng.Offset（0，1） .PasteSpecial Paste：= xlPasteValues，操作：= xlNone，SkipBlanks _ ：= False，Transpose：= False x = x + 1 如果 Wend End Sub

但是，这将onl; y给我两者之间的精确匹配。有可能做同样的事情，但是列C列出来的文本只能构成列A的一部分，触发复制/粘贴行？

谢谢

解决方案

考虑：

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 对于每个aa在A va = aa.Value boo = False 对于每个cc in C 如果InStr（1，va，cc.Value）> o然后boo = True 下一个cc 如果boo然后 aa.Copy单元格（K，B） K = K + 1 End If 下一个aa End Sub

之前：

之后：

If I have a long list of text in Column A, and a short list of words in Column C, what would be the best way to go about searching each cell in A for any of the words in C, and copy and paste the ones that match out into Column B?

The code I have written so far is as follow

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

However, this will onl;y give me exact matches between the two. Is it possible to do the same, but have text that appears in Column C, while only making up part of Column A, trigger the copy/paste line?

Thanks

解决方案

Consider:

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

Before:

and after: