excel vba regex模式完全匹配的字符串

Question

嗨，我正在尝试修复我的代码以执行以下操作（在某些情况下）

excel中有2列：P列和S列。这两列长成千上万行。

P列都是多行文本字符串（产品说明） S列都是多行文本字符串（产品评论）

我需要编写一个vba函数，该函数将查找P列中的单元格，如果与S列中的值有关的匹配项返回精确的字符串匹配。

示例：

使用正则表达式，我能够使用以下代码一次比较一行（从P3到S3）：

Public Function RxMatch( _
 ByVal SourceString As String, _
 ByVal Pattern As String, _
 Seperator As String, _
 Optional ByVal IgnoreCase As Boolean = True, _
 Optional ByVal MultiLine As Boolean = True) As Variant

Dim arrWords() As String
arrWords = Split(SourceString, separator)

 Dim oMatches As MatchCollection
 For Each word In arrWords
 With New RegExp
    .MultiLine = MultiLine
    .IgnoreCase = IgnoreCase
    .Global = False
    .Pattern = Pattern
    Set oMatches = .Execute(SourceString)
    If oMatches.Count > 0 Then
        RxMatch = oMatches(0).Value
    Else
        RxMatch = "No match"
    End If
 End With
 Next word

 End Function

但是，除了将P3与S3进行匹配之外，我需要将P3与S列的所有内容进行比较，以查看是否有任何描述具有匹配项。有没有一种方法可以更新我提供的代码，以使其与整个S列匹配，而不是与单元格匹配？

Answer 1

如果您对任何隐藏的字符，换行符等都很注意，那么您应该可以使用数组和Instr函数。

Option Explicit
Public Sub FindMatches()
    Dim arr(), i As Long, j As Long
    With ActiveSheet
        arr = .Range("P1:T" & .Cells(.Rows.Count, "P").End(xlUp).Row).Value
        For i = LBound(arr, 1) To UBound(arr, 1)
            For j = LBound(arr, 1) To UBound(arr, 1)
                If InStr(arr(i, 1), arr(j, 4)) > 0 Then arr(i, 5) = arr(i, 5) & "," & arr(j, 4)
            Next j
        Next i
        For i = LBound(arr, 1) To UBound(arr, 1)
            arr(i, 5) = Application.WorksheetFunction.Substitute(arr(i, 5), ",", vbNullString, 1)
        Next i
        .Range("P1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    End With
End Sub

---

在T列中具有输出的数据集：