VBA, de recherche dans la colonne de caractère spécifique, extrait de la chaîne jusqu'à ce personnage

Cette question est bien adapté pour les expressions régulières. La fonction suivante renvoie la position du caractère précédant le premier match d'une simple regex motif dans une chaîne donnée. Si aucune correspondance n'est trouvée, la fonction retourne la longueur de la chaîne. La fonction peut être combinée avec la fonction GAUCHE pour extraire le texte qui précède le match. (L'utilisation de la GAUCHE est nécessaire parce que, par souci de simplicité, cette fonction ne permet pas de mettre en œuvre submatches.)

La formule suivante permet d'extraire les noms de produit dans votre échantillon de données:

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

Briser le match motif " \(|\/| -| \*":

  " \("  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 (*).

Pour en savoir plus sur les expressions régulières, consultez cette expression régulière tutoriel, l'un des nombreux disponibles sur le web.

Pour que la fonction puisse fonctionner, vous devez définir une référence à Microsoft VBScript Regular Expressions 5.5. Pour ce faire, sélectionnez Outils/Références de l'IDE VBA et de vérifier cet élément, qui sera ainsi jusqu'à la longue liste de références.

  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 

La sous-routine suivante s'applique à la chaîne d'extraction de chaque cellule dans la colonne de données et écrit la nouvelle chaîne de caractères à un résultat déterminé colonne. Bien qu'il serait possible de simplement appeler la fonction pour chaque cellule dans la colonne de données, cela permettrait de payer les frais généraux de la compilation de l'expression régulière (qui s'applique à toutes les cellules) chaque fois que la fonction a été appelée. Pour éviter cette surcharge de travail, la sous-routine divise la fonction de match en deux parties, la définition du modèle en dehors de la boucle à travers les cellules de données, et le modèle d'exécution à l'intérieur de la boucle.

  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

Vous pouvez utiliser le Split() fonction. Voici un exemple:

Dim text as String
Dim splt as Variant
text = "Samsung/Dhamal"
splt = Split(text, "/")
MsgBox splt(0)

Il suffit de faire la même chose pour n'importe quel autre caractère que vous voulez diviser. En savoir plus sur ce sur MSDN: http://msdn.microsoft.com/fr-fr/library/6x627e5f%28v=vs.80%29.aspx

L'autre (mieux?) alternative que je vois serait d'utiliser InStr() avec Left(). InStr() renvoie la position du premier match qu'il trouve. Ensuite vous avez juste à recadrer votre chaîne. Voici un exemple:

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