在列中每个单元格的特定单词之后查找字符串?

时间:2018-07-31 15:22:21

标签: excel vba excel-vba

我需要在句子中查找姓名的帮助。在A列中,我有很多句子,每个句子可能包含一个“ PM:{name}”子字符串,如下所示:

enter image description here

某些单元格可能不包含此单元格,但是对于那些我想在B列中的每个句子旁边打印B列中的字符串名称的人。

这是我到目前为止的内容,但仅适用于单元格A2。我需要它对A列中所有具有“ PM:Name”的单元格起作用。(我现在手动写了Sara)

Option Explicit

Sub PMName()
    Dim ws As Worksheet

    Dim Reg1 As Object
    Dim RegMatches As Variant
    Dim Match As Variant
    Dim NextWord As Boolean
    Dim LR As Long

    Dim i As Long
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        Set Reg1 = CreateObject("VBScript.RegExp")
        With Reg1
            .Global = True
            .IgnoreCase = True
            .Pattern = "\w{1,50}"
        End With

        Set RegMatches = Reg1.Execute(Cells(i, 1).Value)
        NextWord = False '
        If RegMatches.Count >= 1 Then
            For Each Match In RegMatches
                If NextWord Then
                    Cells(i, 2).Value = Match
                    Exit Sub
                End If
                If UCase(Match) Like "PM" Then NextWord = True
            Next Match
        End If
    Next i
End Sub

3 个答案:

答案 0 :(得分:1)

您可以这样做,使用子匹配项(在方括号中)识别要提取的特定位。我还假设每个单元格中只有一个匹配项。

Sub Regex1()

Dim oRgx As Object, r As Range

Set oRgx = CreateObject("VBScript.RegExp")

With oRgx
    .Global = True
    .Pattern = "PM: (\w+)"
    For Each r In Range("A1", Range("A" & Rows.Count).End(xlUp))
        If .Test(r) Then
            r.Offset(, 1) = .Execute(r)(0).submatches(0)
        End If
    Next r
End With

End Sub

答案 1 :(得分:1)

您可以通过简单地更改样式来解决此问题。这将使用一个非捕获组在字符串中找到与PM: <name>匹配的位置,然后使用子匹配函数(括号中的模式)仅返回该子字符串的<name>部分。通过为每个子匹配增加Offset,也可以轻松处理多个匹配

Public Sub PMName()
    Dim rng As Range
    Dim c, match, submatch

    With ActiveSheet ' Change this to your relevant sheet
        Set rng = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
    End With

    With CreateObject("VBScript.RegExp")
        .Global = True
        .ignorecase = True
        .Pattern = "(?:PM\:\s{0,}(\w{1,50}))"
        For Each c In rng
            If .test(c.Value2) Then
                For Each match In .Execute(c)
                    For Each submatch In match.submatches
                        Debug.Print match, submatch
                        c.Offset(0, 1).Value2 = submatch
                    Next submatch
                Next match
            End If
        Next c
    End With
End Sub

答案 2 :(得分:1)

我认为您也可以在不使用正则表达式的情况下执行此操作:

iCalUid

输出:

enter image description here