VBA，在列中搜索特定字符，提取字符串直至该字符

Question

在特定列中，我想在单元格中搜索特定字符...例如“(”或“/”。在单元格中找到该字符后，我想从单元格的开头提取该部分字符串直到在与其相邻的单元格中找到该字符为止。

例如该列中的一些值可能类似于 -

Samsung (india)
Samsung/Dhamal
Blackberry (chikna)
Blackberry/Kala Anda
iPhone - egypt
iPhone 5 * yeda

输出看起来像 -

Samsung
Samsung
Blackberry
Blackberry
iPhone
iPhone 5

注意:该特定列中的单元格值不是静态的，没有模式，也可能包含其他特殊字符，没有特定的长度。

Answer 1

这个问题非常适合正则表达式。以下函数返回给定字符串中简单正则表达式模式的第一个匹配项之前的字符的位置。如果未找到匹配项，该函数将返回字符串的长度。该函数可以与 LEFT 函数结合使用以提取匹配项之前的文本。 (使用 LEFT 是必要的，因为为了简单起见，该函数不实现子匹配。)

以下公式将提取示例数据中的产品名称:

  =LEFT(A1,regexmatch(A1," \(|\/| -| \*"))

分解匹配模式"\(|\/| -|\*":

  " \("  matches a space followed by a left parenthesis 
         [the backslash escapes the "(", a special character in regular expressions] 

  "|"    signifies an alternative pattern to match

  "\/"   matches a forward slash (/)

  " -"   matches a space followed by a dash (-)

  " \*"  matches a space followed by an asterisk (*).

要了解有关正则表达式的更多信息，请参阅此 regular expression tutorial ，网络上提供的众多内容之一。

为了使该函数正常工作，您需要设置对 Microsoft VBScript 正则表达式 5.5 的引用。为此，请从 VBA IDE 中选择“工具/引用”并选中此项，该项目将位于一长串引用列表的下方。

  Function regexMatch(text As String, rePattern As String)
      'Response to SO post 16591260
      'Adapted from code at http://www.macrostash.com/2011/10/08/
      '    simple-regular-expression-tutorial-for-excel-vba/.

      Dim regEx As New VBScript_RegExp_55.RegExp
      Dim matches As Variant

      regEx.pattern = rePattern
      regEx.IgnoreCase = True 'True to ignore case
      regEx.Global = False    'Return just the first match

      If regEx.Test(text) Then
         Set matches = regEx.Execute(text)
         regexMatch = matches(0).FirstIndex
      Else
         regexMatch = Len(text)
      End If

  End Function 

以下子例程将字符串提取应用于指定数据列中的每个单元格，并将新字符串写入指定的结果列。尽管可以为数据列中的每个单元格调用该函数，但这会产生每次调用该函数时编译正则表达式(适用于所有单元格)的开销。为了避免这种开销，子例程将匹配函数分为两部分，模式定义在循环外部通过数据单元，模式执行在循环内部。

  Sub SubRegexMatch()
      'Response to SO post 16591260
      'Extracts from string content of each data cell in a specified source
      '   column of the active worksheet the characters to the left of the first
      '   match of a regular expression, and writes the new string to corresponding
      '   rows in a specified result column.
      'Set the regular expression, source column, result column, and first
      '   data row in the "parameters" section
      'Regex match code was adapted from http://www.macrostash.com/2011/10/08/
      '   simple-regular-expression-tutorial-for-excel-vba/

      Dim regEx As New VBScript_RegExp_55.RegExp, _
          matches As Variant, _
          regexMatch As Long     'position of character *just before* match
      Dim srcCol As String, _
          resCol As String
      Dim srcRng As Range, _
          resRng As Range
      Dim firstRow As Long, _
          lastRow As Long
      Dim srcArr As Variant, _
          resArr() As String
      Dim i As Long

      'parameters
      regEx.Pattern = " \(|\/| -| \*"    'regular expression to be matched
      regEx.IgnoreCase = True
      regEx.Global = False               'return only the first match found
      srcCol = "A"                       'source data column
      resCol = "B"                       'result column
      firstRow = 2                       'set to first row with data

      With ActiveSheet
          lastRow = .Cells(Cells.Rows.Count, srcCol).End(xlUp).Row
          Set srcRng = .Range(srcCol & firstRow & ":" & srcCol & lastRow)
          Set resRng = .Range(resCol & firstRow & ":" & resCol & lastRow)
          srcArr = srcRng
          ReDim resArr(1 To lastRow - firstRow + 1)
          For i = 1 To srcRng.Rows.Count
              If regEx.Test(srcArr(i, 1)) Then
                  Set matches = regEx.Execute(srcArr(i, 1))
                  regexMatch = matches(0).FirstIndex
              Else
                  regexMatch = Len(srcArr(i, 1)) 'return length of original string if no match
              End If
              resArr(i) = Left(srcArr(i, 1), regexMatch)
          Next i
          resRng = WorksheetFunction.Transpose(resArr) 'assign result to worksheet
      End With
  End Sub