Question

在特定列中，我想在单元格中搜索特定字符...说“（”或“/”。一旦在单元格中找到此字符，我想从开头提取该部分在与其相邻的单元格中找到该字符的字符串。

E.g。列中的一些值可能看起来像 -

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 Regular Expressions 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

Answer 2

这样的事情会起作用：

=IF(FIND("(",A1),LEFT(A1,FIND("(",A1)-1),IF(FIND("\",A1),LEFT(A1,FIND("\",A1)-1),""))

如果你有两个以上的字符嵌套在更多的IF语句中。在达到Cell函数的迭代限制之前，您可以执行多少操作。

Answer 3

您可以使用Split()功能。这是一个例子：

Dim text as String
Dim splt as Variant

text = "Samsung/Dhamal"
splt = Split(text, "/")
MsgBox splt(0)

对要分割的任何其他角色执行相同操作。有关MSDN的更多信息：http://msdn.microsoft.com/fr-fr/library/6x627e5f%28v=vs.80%29.aspx

我看到的另一个（更好？）替代方案是将InStr()与Left()一起使用。 InStr()返回找到的第一个匹配项的位置。然后你只需要裁剪你的字符串。这是一个例子：

Dim text as String
Dim position as Integer

text = "Samsung/Dhamal"
position = InStr(text, "/")

If position > 0 then MsgBox Left(text, position)

http://msdn.microsoft.com/fr-fr/library/8460tsh1%28v=vs.80%29.aspx

Answer 4

这应该适合你：

Public Function IsAlphaNumeric(sChr As String) As Boolean
    IsAlphaNumeric = sChr Like "[0-9A-Za-z]"
End Function

Sub LeftUntilNonAlphaNumericChar()
    Dim cell As Range
    Dim Counter As Integer
    Dim NumCharsLeftOfNonAlphaNumChar As Long
    Set colRng = ActiveSheet.Range("A1:A1000") 'specify range

    For Each cell In colRng
        If Len(cell.Text) > 0 Then
            MyString = cell.Value
            For Counter = Len(cell.Text) To Counter Step -1
                If IsAlphaNumeric(cell.Characters(Counter, 1).Text) = False And cell.Characters(Counter, 1).Text <> " " Then
                    cell.Offset(0, 1).Value = Left(cell.Value, Counter - 1)
                End If
            Next
        End If
    Next cell
End Sub

它不会删除末尾的尾随空格，但如果你想要的话，对sub的简单添加可能会改变它。祝你好运。

<强>此外：您可以使用列中的数据获取最后一个单元格的行，并在您的范围内使用该行（参见下文）：

Public Function IsAlphaNumeric(sChr As String) As Boolean
    IsAlphaNumeric = sChr Like "[0-9A-Za-z]"
End Function

Sub LeftUntilNonAlphaNumericChar()
    Dim cell As Range
    Dim Counter As Integer
    Dim NumCharsLeftOfNonAlphaNumChar As Long

    Dim LastRow As Long
    If Application.Version >= 12# Then
        LastRow = ActiveSheet.Range("A1048575").End(xlUp).Row + 1
        'MsgBox "You are using Excel 2007 or greater."
    Else
        LastRow = ActiveSheet.Range("A65535").End(xlUp).Row + 1
        'MsgBox "You are using Excel 2003 or lesser."
    End If
    Set colRng = ActiveSheet.Range("A1:A" & LastRow) 'specify range

    For Each cell In colRng
        If Len(cell.Text) > 0 Then
            MyString = cell.Value
            For Counter = Len(cell.Text) To Counter Step -1
                If IsAlphaNumeric(cell.Characters(Counter, 1).Text) = False And cell.Characters(Counter, 1).Text <> " " Then
                    cell.Offset(0, 1).Value = Left(cell.Value, Counter - 1)
                End If
            Next
        End If
    Next cell
End Sub

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

4 个答案: