セル配列から文字列を抽出する

Question

以下のコードは、セル内の文字列を検索し、その前に来る検索語と単語の両方を抽出します。

検索語が「（hello）」のときはコードが機能しますが、「hello hey」にするとコードが見つかりません。私は "hello"と "hey"の間の空白を想定していますが、その変更をどうやって行うのかは分かりません。

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


    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 

      'split to array 
      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 
        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 1

代わりのスペースで分割、あなたがスペースで、検索ワードによって分割とすることができます

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 2

一つのアプローチは、単に別の文字（例えば^）との最初のスペースを交換することと、完全なスペースの残りの部分を残します。今度は、新しく導入された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 3

私は、テキストにフレーズを見つけるために、INSTRを使用し、その後正規表現は前の最後の言葉を見つけますフレーズ。それはスペースが含まれているため

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