匹配和提取带有通配符的关键词和句子

liulang0808

Sub 按钮4_Click()
    arr = ActiveSheet.UsedRange
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "[\d一-龥]*?(建议：|可适当|互动).*"
        .Global = True
        For j = 2 To UBound(arr)
            If .test(arr(j, 3)) Then
                str1 = ""
                For Each m In .Execute(arr(j, 3))
                    If Len(str1) < Len(m.Value) Then str1 = m.Value
                Next m
                 arr(j, 6) = str1
            End If
        Next j
    End With
    ActiveSheet.UsedRange = arr
End Sub

liulang0808

模拟了一个，不清楚是否满足需求的

qlmgu

liulang0808 发表于 2023-3-6 09:32
模拟了一个，不清楚是否满足需求的

感谢群主出手相助，测试模拟数据完全正确，非常感谢版主又一次出手相助。

不知道能否麻烦版主帮我 1.把匹配到的关键词*返回到D列？这样做主要是方便后期筛选；2.可以增加关键词和文本的数量。这样就完美了。

再次感谢版主。