在VBA中匹配字符串中的单个单词

时间:2022-09-13 11:49:52

Excel 2013 here - and am attempting to match the value in cell D to the value in cell C. The part that is leaving me pulling my hair out, is the fact that if a single word exists in column C it should be removed from column D.

Excel 2013在这里,我试图将cell D中的值与cell C中的值相匹配,让我把头发拔出来的部分是,如果C列中有一个单词,那么应该从D列中删除。

For example

例如

Column C          Column D
Red Hairy Hats    Hairy Cowpies

Since both fields contain the word Hairy it should be updated to read like so

由于这两个字段都包含有“有毛”这个词,因此应该将其更新为“有毛”

Column C          Column D
Red Hairy Hats    Cowpies

I can not uncover how to do a wildcard match on string comparison in Excel VBA. I have this syntax which does an Exact match, but how could I do single words from the string like in my example above?

我无法发现如何在Excel VBA中进行字符串比较的通配符匹配。我有这个语法,它做了一个精确的匹配,但是我怎么能像上面的例子那样,从字符串中单独输入单词呢?

Dim i As Long
Dim resArry
dataArry = Cells(1).CurrentRegion
ReDim resArry(UBound(dataArry, 1) - 1, 1)
For i = 2 To UBound(dataArry, 1)
    If InStr(1, dataArry(i, 3), dataArry(i, 4), vbBinaryCompare) Then
        resArry(i - 2, 0) = ""
    Else
        resArry(i - 2, 0) = dataArry(i, 4)
    End If
Next

Range("D2").Resize(UBound(resArry, 1)) = resArry

3 个解决方案

#1


1  

A RegExp option with variant arrays.

具有不同数组的RegExp选项。

Create a pattern for each C string against each D string for a whole word only replacement

为每个C字符串创建一个模式,每个D字符串对应一个完整的替换词

\b(Red|Hairy|Hats)\b

\ b(红色| |毛帽子)\ b

etc

Sub Interesting()
Dim rng1 As Range
Dim X, Y
Dim lngCnt As Long
Dim ObjRegex As Object

Set rng1 = Range([c1], Cells(Rows.Count, "c").End(xlUp))
X = rng1.Value2
Y = rng1.Offset(0, 1).Value2
Set ObjRegex = CreateObject("vbscript.regexp")
With ObjRegex
.Global = True
For lngCnt = 1 To UBound(X, 1)
    .Pattern = "\b(" & Join(Split(X(lngCnt, 1), Chr(32)), "|") & ")\b"
    Y(lngCnt, 1) = .Replace(Y(lngCnt, 1), vbNullString)
    Next
End With

rng1.Offset(0, 1).Value2 = Y

End Sub

#2


0  

This is not a complete answer, since I’m a bit rusty with VBA, but rather than use instr to look for matches, you might have more success splitting both strings into arrays.

这并不是一个完整的答案,因为我对VBA有些生疏,但是与其使用instr查找匹配,不如将两个字符串分割成数组。

The process would be something like this:

这个过程是这样的:

  • split both strings using space
  • 使用空格分割两个字符串
  • for each element in the second array
    • test whether it’s in the first array
    • 测试它是否在第一个数组中
    • if it is, remove the element
    • 如果是,则删除元素
  • 对于第二个数组中的每个元素,测试它是否在第一个数组中(如果在第一个数组中),删除该元素
  • Join the second array back into a string using spaces
  • 使用空格将第二个数组连接回字符串
  • Repeat and rinse
  • 重复和冲洗

#3


0  

Private Sub Test()
    Dim C As String, D As String
    C = "Red Hairy Hats"
    D = "hairy cowpies"
    Debug.Print RemoveMatches(C, D)
End Sub

Private Function RemoveMatches(C As String, D As String) As String
    Dim Sp() As String
    Dim i As Integer

    Sp = Split(C)
    For i = 0 To UBound(Sp)
        If InStr(1, D, Sp(i), vbTextCompare) Then
            D = Trim(Replace(D, Sp(i), "", Compare:=vbTextCompare))
        End If
    Next i
    RemoveMatches = D
End Function

#1


1  

A RegExp option with variant arrays.

具有不同数组的RegExp选项。

Create a pattern for each C string against each D string for a whole word only replacement

为每个C字符串创建一个模式,每个D字符串对应一个完整的替换词

\b(Red|Hairy|Hats)\b

\ b(红色| |毛帽子)\ b

etc

Sub Interesting()
Dim rng1 As Range
Dim X, Y
Dim lngCnt As Long
Dim ObjRegex As Object

Set rng1 = Range([c1], Cells(Rows.Count, "c").End(xlUp))
X = rng1.Value2
Y = rng1.Offset(0, 1).Value2
Set ObjRegex = CreateObject("vbscript.regexp")
With ObjRegex
.Global = True
For lngCnt = 1 To UBound(X, 1)
    .Pattern = "\b(" & Join(Split(X(lngCnt, 1), Chr(32)), "|") & ")\b"
    Y(lngCnt, 1) = .Replace(Y(lngCnt, 1), vbNullString)
    Next
End With

rng1.Offset(0, 1).Value2 = Y

End Sub

#2


0  

This is not a complete answer, since I’m a bit rusty with VBA, but rather than use instr to look for matches, you might have more success splitting both strings into arrays.

这并不是一个完整的答案,因为我对VBA有些生疏,但是与其使用instr查找匹配,不如将两个字符串分割成数组。

The process would be something like this:

这个过程是这样的:

  • split both strings using space
  • 使用空格分割两个字符串
  • for each element in the second array
    • test whether it’s in the first array
    • 测试它是否在第一个数组中
    • if it is, remove the element
    • 如果是,则删除元素
  • 对于第二个数组中的每个元素,测试它是否在第一个数组中(如果在第一个数组中),删除该元素
  • Join the second array back into a string using spaces
  • 使用空格将第二个数组连接回字符串
  • Repeat and rinse
  • 重复和冲洗

#3


0  

Private Sub Test()
    Dim C As String, D As String
    C = "Red Hairy Hats"
    D = "hairy cowpies"
    Debug.Print RemoveMatches(C, D)
End Sub

Private Function RemoveMatches(C As String, D As String) As String
    Dim Sp() As String
    Dim i As Integer

    Sp = Split(C)
    For i = 0 To UBound(Sp)
        If InStr(1, D, Sp(i), vbTextCompare) Then
            D = Trim(Replace(D, Sp(i), "", Compare:=vbTextCompare))
        End If
    Next i
    RemoveMatches = D
End Function