Résolu VBA portée function

kevin_44

XLDnaute Nouveau
Bonjour,

je ne parviens pas à exécuter une fonction personnalisée, je suis sûr que c'est tout bête mais je débute en VBA...

1/ Je créé une fonction qui liste des positions de caractères dans une chaîne, l'objectif étant de les supprimer s'ils sont doublés. Le but est un peu d'opérer comme une fonction SUPPRESPACE mais en choisissant les caractères que je traite (en l’occurrence, les espaces puis les sauts de ligne)

VB:
Public Function sup_car(txt As String) As String

' Tableau : liste des caractères à traiter
Dim caractere(1)
caractere(0) = chr(32) ' espace
caractere(1) = chr(10) ' saut de ligne


For x = LBound(caractere) To UBound(caractere) Step 1

    ' Position des caractères à supprimer
    ReDim car(Len(txt)) As String

    For a = 1 To Len(txt) Step 1
        If Right(Left(txt, a), 1) = caractere(x) And Right(Left(txt, a - 1), 1) = caractere(x) Then car(a) = a
    Next a

    ' Suppression des caractères aux positions déterminées
    For b = Len(txt) To 1 Step -1
        If car(b) <> "" Then
        txt = Left(txt, b - 1) & Right(txt, Len(txt) - b)
        End If
    Next b

    ' Suppression des espaces de début et fin de chaîne
    If Left(txt, 1) = caractere(x) Then txt = Right(txt, Len(txt) - 1)
    If Right(txt, 1) = caractere(x) Then txt = Left(txt, Len(txt) - 1)

Next x

End Function
2/ J'appelle cette fonction dans un autre module (dans un MsgBox pour le test)

VB:
Sub test()

    MsgBox sup_car("  xx   x x   x   x  x x x  x")

End Sub
Malgré cela, le MsgBox est vide.

Savez-vous me dire où je me trompe ?

En utilisant un point d'arrêt dans ma fonction, je constate que je rentre bien dedans pourtant (voir pièce jointe)...

Merci :)
 

Fichiers joints

sylvanu

XLDnaute Accro
Supporter XLD
Bonjour Kevin,
Il me semble que dans votre fonction il manque la ligne la plus importante : le retour de valeur.
A la fin d'une fonction, on doit attribuer la valeur calculée à la function.
VB:
sup_car = txt
End Function
Bonjour Laurent.
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil

Essaies avec ce petit ajout
VB:
Public Function sup_car(txt As String) As String
' Tableau : liste des caractères à traiter
Dim caractere(1)
caractere(0) = Chr(32) ' espace
caractere(1) = Chr(10) ' saut de ligne
For x = LBound(caractere) To UBound(caractere) Step 1

    ' Position des caractères à supprimer
    ReDim car(Len(txt)) As String

    For a = 1 To Len(txt) Step 1
        If Right(Left(txt, a), 1) = caractere(x) And Right(Left(txt, a - 1), 1) = caractere(x) Then car(a) = a
    Next a

    ' Suppression des caractères aux positions déterminées
    For b = Len(txt) To 1 Step -1
        If car(b) <> "" Then
        txt = Left(txt, b - 1) & Right(txt, Len(txt) - b)
        End If
    Next b

    ' Suppression des espaces de début et fin de chaîne
    If Left(txt, 1) = caractere(x) Then txt = Right(txt, Len(txt) - 1)
    If Right(txt, 1) = caractere(x) Then txt = Left(txt, Len(txt) - 1)

Next x
sup_car = txt
End Function
EDITION: Désolé pour le double télescopage, je n'avais pas rafraîchi la page.
Bonjour sylvanu , bonjour laurent3372
 

kevin_44

XLDnaute Nouveau
Ah quelle nouille je fais :) Merci beaucoup laurent3372 !

Je mets en résolu.

(juste pour ceux qui reliraient ce message, une petite coquille --> c'est avant le "end function" et non le "end sub" qu'il faut ajouter "sup_car = txt")
 

Staple1600

XLDnaute Barbatruc
Re

Merci à vous deux du coup, on s'est croisé
=>kevin_44
Nous étions trois à passer dans ton fil... :rolleyes:
Mais j'ai l’habitude d'être zappé.
Je survivrai (même si cela fait mal en dedans de moi ;) Ouch!)
 
Dernière édition:

kevin_44

XLDnaute Nouveau
Oups :) Merci beaucoup à toi aussi Staple1600 ;-)

Et quelle réactivité !

Bonne journée.
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas