VBA，在列中search特定字符，提取string到该字符
在特定的列中，我想在单元格中search特定的字符…说“（”或“/”。一旦在单元格中find这个字符，我想从string的开始部分提取部分指出这个字符是在它旁边的单元格中find的。
例如，列中的一些值可能看起来像 –
Samsung (india) Samsung/Dhamal Blackberry (chikna) Blackberry/Kala Anda iPhone - egypt iPhone 5 * yeda 输出看起来像 –
Samsung Samsung Blackberry Blackberry iPhone iPhone 5
注：该特定列中的单元格值不是静态的，没有模式，也可能包含其他特殊字符，不是特定的长度。
这个问题非常适合正则expression式。 以下函数返回给定string中简单正则expression式模式的第一个匹配之前的字符的位置。 如果找不到匹配，则函数返回string的长度。 这个函数可以和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 (*).
要了解有关正则expression式的更多信息，请参阅这个正则expression式教程 ，它是网上许多可用的教程之一
为了使该function正常工作，您需要设置对Microsoft VBScript正则expression式5.5的引用。 要做到这一点，从VBA IDE中select工具/引用，并检查这个项目，这将是很长的参考文献列表。
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
以下子例程将string提取应用于指定数据列中的每个单元格，并将新string写入指定的结果列。 尽pipe可能只是为数据列中的每个单元调用函数，但是每次调用该函数时都会产生编译正则expression式（适用于所有单元）的开销。 为避免这种开销，子例程将匹配函数分成两部分，循环之外的模式定义通过数据单元，循环内部执行模式。
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
像这样的东西将工作：
=IF(FIND("(",A1),LEFT(A1,FIND("(",A1)-1),IF(FIND("\",A1),LEFT(A1,FIND("\",A1)-1),""))
如果不止两个字符嵌套在更多的IF语句中。 在达到单元格函数的迭代限制之前，您可以执行多less操作。
你可以使用Split()函数。 这里是一个例子：
Dim text as String Dim splt as Variant text = "Samsung/Dhamal" splt = Split(text, "/") MsgBox splt(0)
只要你想要分裂的任何其他angular色也一样。 有关MSDN的更多信息，请访问： http : //msdn.microsoft.com/fr-fr/library/6x627e5f%28v=vs.80%29.aspx
另一种（更好的？）替代我看到将与Left()使用InStr() Left() 。 InStr()返回它find的第一个匹配的位置。 那么你只需要裁剪你的string。 这里是一个例子：
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
这应该为你工作：
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
它不会删除结尾的空白，但如果你想要的话，一个简单的添加可以改变。 祝你好运。
附加：你可以得到列中数据的最后一个单元格的行，并在你的范围内使用（见下文）：
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