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 Regular Expressions 5.5的引用。要做到這一點，從VBA IDE中選擇Tools/References，並檢查這個項目，這將在很長的參考文獻列表中。

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 

它不刪除就完了尾部空格，但一個簡單的除子可以改變，如果你想。祝你好運。

此外： 你可以得到的最後一個單元格中的數據的行中的列和使用，在你的範圍（見下文）：

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