Rechercher et supprimer des caractères

[Goulven35]

Bonjour,

Voici mon problème :

A l'issue d'une lecture code barre, j'ai dans une cellule les caractères correspondants à 2 codes qui se trouvent cote à cote sur le support lu. Hors, je ne souhaite conserver que les caractères correspondant à l'un des 2 codes. Heureusement, les bits d'entrée/sortie sont différents. Mais comme les 2 codes ne sont pas toujours bien alignés, il ne sont pas toujours lus dans le même ordre. Je ne peut donc pas utiliser la fonction STXT. Existe-t-il une solution ?

Exemple : Après lecture, j'obtiens les cellules suivantes :
a025658ab070011b
a652536ab281156b
b021134ba285426b
a542687ab072777b
b071702ba984723a

Je souhaite ne concerver que les 6 caractères contenus entre les caractères "b".

Par avance merci.

 

[Efgé]

Re : Rechercher et supprimer des caractères

Bonjour Goulven35,
Un proposition à essayer...(avec les référence en colonne A)

=STXT(A1;CHERCHE("b";A1;1)+1;6)

Cordialement

 

[pierrejean]

Re : Rechercher et supprimer des caractères

bonjour goulven

2 methodes dont 1 par formule personnalisée

Edit Salut Efgé

 

[Goulven35]

Re : Rechercher et supprimer des caractères

Merci beaucoup !

La formule

=STXT(A1;CHERCHE("b";A1;1)+1;6)

fonctionne parfaitement.

Christophe

 

[Staple1600]

Re : Rechercher et supprimer des caractères

Bonjour à tous

Une solution utilisant les expressions régulières

Function code6(txt$)
With CreateObject("VBScript.RegExp")
    .Pattern = "[b]\d{6}"
    code6 = Mid(.Execute(txt)(0), 2, 6)
End With
End Function

Utilisation:
(copier le code de la fonction dans un module)
Ex : si les données en colonne A alors
en B1 , saisir la formule suivante : =code6(A1), puis recopie vers le bas

EDITION 1 : une variante sans le Mid

Function code6(txt$)
With CreateObject("VBScript.RegExp")
.Pattern = "[b]\d{6}": code6 = Replace(.Execute(txt)(0), "b", "")
End With
End Function

EDITION 2 : version pour traiter la colonne A d'un seul coup

Sub extraction_en_masse()
Dim c As Range
For Each c In Range([A1], [A65536].End(xlUp))
    With CreateObject("VBScript.RegExp")
        .Pattern = "[b]\d{6}"
        c.Offset(, 1).NumberFormat = "@"
        c.Offset(, 1) = Replace(.Execute(c.Text)(0), "b", "")
    End With
Next c
End Sub