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

在特定列中，我想在单元格中搜索特定字符…比如“（”或“/”。一旦在单元格中找到该字符，我想从字符串的开头提取该部分，直到在其相邻的单元格中找到该字符为止

例如，列中的一些值可能看起来像-

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

Samsung
Samsung
Blackberry
Blackberry
iPhone
iPhone 5

输出将如下所示-

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

Samsung
Samsung
Blackberry
Blackberry
iPhone
iPhone 5

---

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

类似的操作可以：

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

---

如果不止两个字符嵌套在多个If语句中。在达到单元格函数的迭代限制之前，可以执行的操作量是有限的。

可以使用

Split（）

函数。以下是一个示例：

Dim文本作为字符串
作为变体的Dim splt
text=“三星/Dhamal”
splt=拆分（文本“/”）
MsgBox splt（0）

只需对要拆分的任何其他字符执行相同的操作。有关此操作的更多信息，请访问MSDN：

我看到的另一个（更好的？）选择是使用

InStr（）

和

Left（）

InStr（）

返回它找到的第一个匹配项的位置。然后只需裁剪字符串。以下是一个示例：

Dim文本作为字符串
变暗位置为整数
text=“三星/Dhamal”
位置=仪表（文本“/”）
如果位置>0，则MsgBox向左（文本，位置）

---

此问题非常适合正则表达式。以下函数返回给定字符串中简单正则表达式模式第一次匹配之前的字符位置。如果未找到匹配项，则该函数返回字符串的长度。该函数可以与左函数组合，以提取字符串前面的文本e match.（为了简单起见，必须使用LEFT，因为此函数不实现子匹配。）

以下公式将提取样本数据中的产品名称：

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

分解匹配模式

“\（| \/|-| \*”

：

要了解有关正则表达式的更多信息，请参阅此，这是web上提供的许多正则表达式之一

为了使函数正常工作，您需要设置对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

---

这应该适合您：

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

公共函数为布尔形式的对数（sChr为字符串）
IsAlphaNumeric=sChr-Like“[0-9A-Za-z]”
端函数
次左untilnonalphanumericchar（）
暗淡单元格作为范围
作为整数的Dim计数器
Dim NumcharsLeftOfNationalPhanumChar的长度为
Set colRng=ActiveSheet.Range（“A1:A1000”）'指定范围
对于colRng中的每个单元格
如果Len（cell.Text）>0，则
MyString=cell.Value
For Counter=Len（cell.Text）用于计数器步骤-1
如果IsAlphaNumeric（cell.Characters（Counter，1）.Text）=False，cell.Characters（Counter，1）.Text）=则
cell.Offset（0，1）.Value=Left（cell.Value，计数器-1）
如果结束
下一个
如果结束
下一个细胞
端接头

它不会删除尾随的空格，但是如果你愿意的话，只需在sub中添加一个简单的空格就可以改变它。祝你好运

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

公共函数为布尔形式的对数（sChr为字符串）
IsAlphaNumeric=sChr-Like“[0-9A-Za-z]”
端函数
次左untilnonalphanumericchar（）
暗淡单元格作为范围
作为整数的Dim计数器
Dim NumcharsLeftOfNationalPhanumChar的长度为
最后一排一样长
如果Application.Version>=12#则
LastRow=ActiveSheet.Range（“A1048575”）。结束（xlUp）。行+1
“MsgBox”您正在使用Excel 2007或更高版本
其他的
LastRow=ActiveSheet.Range（“A65535”）。结束（xlUp）。行+1
“MsgBox”您正在使用Excel 2003或更低版本
如果结束
Set colRng=ActiveSheet.Range（“A1:A”&LastRow）”指定范围
对于colRng中的每个单元格
如果Len（cell.Text）>0，则
MyString=cell.Value
For Counter=Len（cell.Text）用于计数器步骤-1
如果IsAlphaNumeric（cell.Characters（Counter，1）.Text）=False，cell.Characters（Counter，1）.Text）=则
cell.Offset（0，1）.Value=Left（cell.Value，计数器-1）
如果结束
下一个
如果结束
下一个细胞
端接头

看起来这并没有考虑到示例项目2和6，其中标记字符前面有空格，或者示例5，其中匹配需要在空格和数字上。@chuff correct，我只做了他在原始问题中的两个。如果他有大量的字符列表来清除VBA，可能会更好。但是如果他的范围很小，像这样的东西会有用的。这是一个样本，而不是复制/粘贴。为他做这一切。=）作为附录，此示例只是显示拆分函数。OP想要做什么，他还必须循环遍历所有需要的单元格并填充相邻的列。显然，但这是一个示例，而不是复制/粘贴。我不知道VBA。

position>0

对字符串有效吗？position sh