Question

下面的代码在单元格中找到一个字符串，并提取搜索词和它前面的单词。

当搜索词保留为＆＃34;（你好）＆＃34;代码可以工作，但是当我做它＆＃34;（你好嘿）＆＃34;代码找不到它。我假设它之间有空白＆＃34;你好＆＃34;和＆＃34;嘿＆＃34;但我不确定如何做出改变。

        EntityRecommendation entityDate;
        EntityRecommendation entityTime;
        result.TryFindEntity("builtin.datetime.date", out entityDate);
        result.TryFindEntity("builtin.datetime.time", out entityTime);
        if ((entityDate != null) & (entityTime != null))
            entities.Add(new EntityRecommendation(type: "DateTime") { Entity = entityDate.Entity + " " + entityTime.Entity });

        else if (entityDate != null)
            entities.Add(new EntityRecommendation(type: "DateTime") { Entity = entityDate.Entity });

        else if (entityTime != null)
            entities.Add(new EntityRecommendation(type: "DateTime") { Entity = entityTime.Entity });

Answer 1

一种方法是用不同的字符替换第一个空格（例如^）并保留其余空格。现在根据新引入的char拆分字符串。

所以，Hi (hello hey) ---> Hi^(hello hey) ---> arr(0)= Hi and arr(1)= (hey hello)

编辑：更新了代码以处理多个条目。不要替换空格，而是替换(和)。有关更多详细信息，请参阅代码内的注释。

Sub test()

    Dim c As Range, v As String, arr, x As Long, e
    Dim d As Range

    Dim arr2


    Set d = Worksheets("Sheet1").Range("F1") '<<results start here

    For Each c In ActiveSheet.Range("D1:D10")
        v = Trim(c.Value)
        If Len(v) > 0 Then

            'normalize other separators to spaces
            v = Replace(v, vbLf, " ")
            'remove double spaces
            Do While InStr(v, "  ") > 0
                v = Replace(v, "  ", " ")
            Loop

            '/ Replace just the first space with ^
            'v = Replace(v, Space(1), "^", , 1) --- Commented as it wont work with multiple entries

            '/ Updated as per your edit in question.
            '/ Replace parenthesis with ^ appended.
            v = Replace(v, Space(1) & "(", "^(")
            v = Replace(v, ")", ")^")

            'split to array
            '/ Now split the array on ^, this way you get to keep the full string inside parenthesis
            arr = Split(v, "^")

            For x = LBound(arr) To UBound(arr)
                e = arr(x)
                'see if array element is a word of interest
                If Not IsError(Application.Match(LCase(e), Array("(hello hey)"), 0)) Then
                    If x > LBound(arr) Then
                        d.Value = arr(x - 1) & " " & e 'prepend previous word

                        '/ This part added as per your edit.
                        '/ It will bring back the word which precedes the search term.
                        arr2 = Split(StrReverse(Trim(arr(x - 1))), Space(1))
                        If UBound(arr2) > 0 Then
                            arr2(UBound(arr2)) = ""
                        End If
                        d.Value = Trim(StrReverse(Join(arr2, Space(1)))) & " " & e

                    Else
                        d.Value = "??? " & e 'no previous word
                    End If
                    Set d = d.Offset(1, 0)
                End If
            Next x
        End If
   Next c

End Sub

Answer 2

不是按空格分割，而是按搜索词分割，然后按空格分割：

Dim ws1 as WorkSheet, d As Range, c As Range
Dim v As String, arr() As String

Set ws1 = WorkSheets("Sheet1")
Set d = ws1.Range("F1") '<<results start here

For Each c In ws1.Range("D1:D10")
    v = WorksheetFunction.Trim(c.Value2) ' the Excel function TRIM() also replaces extra spaces between words to one space
    arr = Split(v, "(hello hey)")
    If UBound(arr) > 0 Then 
        v = arr(0)
        v = Replace(v, vbLf, " ")
        v = Trim(v)
        arr = Split(v) ' split by space to get the last word before the search word
        v = arr(UBound(arr)) ' the last word in arr

        d.Value2 = v
        Set d = d.Offset(1)
    End If
Next c

Answer 3

我使用Instr在文本中找到短语，然后使用RegEx找到短语之前的最后一个单词。

Function getWordBeforePhrase(text As String, phrase As String) As String

    Dim regex As Object, Match As Object
    Dim lEnd As Long

    lEnd = InStr(text, phrase) - 1

    If lEnd Then
        text = Left(text, lEnd)

        Set regex = CreateObject("VBScript.RegExp")
        With regex
            .Global = True
            .Pattern = "\w+"
            Set matches = regex.Execute(text)

        End With

        If matches.Count Then getWordBeforePhrase = matches(matches.Count - 1).Value

        Set regex = Nothing

    End If

End Function

从单元格数组vba中提取字符串

3 个答案: