Fonction d'extraction chaine txt

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

CelluleVide

XLDnaute Occasionnel
Bonjour a tous,

J'essaies de me créer une fonction perso pour extraire une chaine de texte.
Exemple si j'ai en D3 "Piece de 240 x 600 mm" je veux sortir 240 ou 600 suivant l'info av (avant) ou Ap (apres).
J'ai d'abord ecrit la fonction qui marche avec l'enregistreur de macro:
=STXT(D3;TROUVE("x";D3;1)+1;4)
mais en VBA j'ai ensuite un message" sub ou fonction non défini sur le "Find".

Quelqu'un peut me dire pourquoi?

Public Function ChaineTxt(Celulle As Range, Caractère, AvAp As String, NbCar As Integer)
'Variables:
'Cellule: la cellule a lire
'Caractere: Le caractere a trouver
'AvAp: Prendre la chaine avant ou apres Le caractere
'NbCar: nombre de caractere a extraire:
If AvAp = "Av" Then ChaineTxt = Mid(Celulle, Find(Caractère, Celulle, 1)+1, NbCar)
Else
ChaineTxt = Mid(Celulle, Find(Caractère, Celulle, -(NbCar + 1)), NbCar)
End If
End Function
 
Re : Fonction d'extraction chaine txt

bonjour
Function ChaineTxt(Celulle As Range, Caractère, AvAp As String, NbCar As Integer)
'Variables:
'Cellule: la cellule a lire
'Caractere: Le caractere a trouver
'AvAp: Prendre la chaine avant ou apres Le caractere
'NbCar: nombre de caractere a extraire:
If AvAp = "Av" Then
ChaineTxt = Mid(Celulle, WorksheetFunction.Find(Caractère, Celulle, 1) + 1, NbCar)
Else
ChaineTxt = Mid(Celulle, WorksheetFunction.Find(Caractère, Celulle, -(NbCar + 1)), NbCar)
End If
End Function
 
Re : Fonction d'extraction chaine txt

Bonjour mutzik,

Merci pour ta solution qui marche tres bien.

Pourrais-je abuser en demandant s'il est possible de pouvoir mettre la variable AvAp par défaut a "Av" ou de le presenter sous forme de case a cocher? (Av ou Ap)

A+
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Retour