셀 배열의 문자열 추출

Question

아래 코드는 셀에 문자열을 찾고 그 앞에 오는 단어와 단어를 모두 추출합니다.

검색 단어가 "(안녕하세요)"로 남겨지면 코드가 작동하지만 "안녕하세요"로 만들면 코드에서 찾을 수 없습니다. "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

을 그때 정규식 전에 마지막 단어를 찾기 위해 텍스트 문구를 찾기 위해 측량기를 사용 문구.

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