如何循环通过单词列表并在Excel VBA中的RegEx中测试这些?

Question

我有一个Excel工作簿，有两张表，a和b。

工作表A包含许多不同的非结构化数据，工作表B, Col A，包含多达100个字符串(每个有1-4个单词)，每行一个。

我使用VBA循环遍历工作表A中的所有行，在工作表A中查找包含工作表b中字符串的单元格。如果找到，则将发现的行复制到工作表c中。

到目前为止，一切都很好，我使用的代码工作得很好。

我的问题是表B中的数据是静态的，我希望使其动态，以便可以添加或删除字符串。我将这样做的方式是从数据库中填充表B，其中字符串保持更新。

我使用的代码将只测试表B中的第一个单词，如果没有找到第一个单词，它将不会移动到下一个。

代码需要循环遍历工作表A，对于每一行，它需要循环遍历工作表B中的单词列表，直到找到单词，进行复制粘贴，然后移动到工作表A中的下一行。

如果我在查找表a时可以使用RegEx，那么表B中的单词列表将会短得多。

所以我的问题是，我认为要做到这一点，我需要保存每个字符串在表B作为一个变量，然后在RegEx表达式中使用这个变量，并使用该RegEx在查找?

或者有人有不同的想法，也许在正确的方向上指出我如何编写缺失的代码?

我现在使用的代码是:

Sub Find()
Dim sh1 As Worksheet, sh2 As Worksheet, rng As Range, cel As Range
Dim rngCopy As Range, lastR1 As Long, lastR2 As Long
Dim strSearch1 As String, strSearch2 As String
Dim va, vb
Dim i As Long
Dim d As Object

Set sh1 = ActiveSheet
Set sh2 = Worksheets("SheetC")

lastR1 = sh1.Range("E" & Rows.Count).End(xlUp).Row
lastR2 = sh2.Range("A" & Rows.Count).End(xlUp).Row + 1

With Sheets("SheetB")  'this is where the list is
va = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With

Set d = CreateObject("scripting.dictionary")
d.CompareMode = vbTextCompare
For i = 1 To UBound(va, 1)
d(va(i, 1)) = Empty
Next

vb = sh1.Range("E1:E" & lastR1)
For i = 2 To UBound(vb, 1)
If d.Exists(vb(i, 1)) Then
If rngCopy Is Nothing Then
Set rngCopy = sh1.Rows(i)
Else
Set rngCopy = Union(rngCopy, sh1.Rows(i))
End If
End If
Next

If Not rngCopy Is Nothing Then
rngCopy.Copy Destination:=sh2.Cells(lastR2, 1)
End If
End Sub

<代码>

Answer 1

PP_3