Excel VBA регулярных выражений шаблон точное совпадение строк - PullRequest
Новая
       13

Excel VBA регулярных выражений шаблон точное совпадение строк

0 голосов
/ 03 июля 2018

Привет, я пытаюсь исправить свой код, чтобы сделать следующее (с некоторым контекстом)

В Excel есть 2 столбца: столбец P и столбец S. Длина обоих столбцов составляет тысячи и тысячи.

Столбец P - это многострочные текстовые строки (описания продуктов). Столбец S - это многострочные текстовые строки (комментарии продуктов)

Мне нужно написать функцию vba, которая будет смотреть на ячейку в столбце P и возвращать точное совпадение строки, если есть совпадение, относящееся к значениям в столбце S.

Пример: enter image description here

Используя регулярные выражения, я смог сделать это, сравнивая по одной строке за раз (от 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 вместо ячейки к ячейке?

1 Ответ

0 голосов
/ 03 июля 2018

Если вы осторожны с любыми скрытыми символами, переносами строк и т. Д., Тогда вы сможете использовать массивы и функцию 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:

Dataset

...