Excel VBA正則表達式模式精確字符串匹配

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列中具有輸出的數據集：