Rechercher remplacer dans chaîne de caractères

Daybouk · 31 Octobre 2017

Bonjour,

Je cherche à remplacer des éléments d'une chaîne de caractères (de longueur variable) par d'autres en utilisant le principe de RECHERCHEV.

Je m'explique :
- j'ai des cellules contenant des codes séparés par une virgule
Ex :
3701,3725
0504
0501,0503,0502,0504,0523,0505,0506,0550

- chaque code a un équivalent en lettre (voir onglet "Tab d'équivalence" dans le fichier joint)
Ex :
3701 = SIN
3725 = MAL
0504 = SER
etc.

- je veux remplacer chaque code par son équivalent lettre en les séparant par un tiret et en gardant l'ordre.
Ex du résultat :
3701,3725 => SIN,MAL
0504 => SER
0501,0503,0502,0504,0523,0505,0506,0550 => CRO,BOS,SLO,SER,MON,MCD,ALB,KOS

Je prends les solutions formules Excel ou VBA !

Merci pour votre aide.

Jacky67 · 31 Octobre 2017

Bonjour,
A tester le classeur en PJ

mapomme · 1 Novembre 2017

Bonjour Daybouk et bienvenue sur XLD , Jacky67, zebanx,

Un essai avec une fonction personnalisée (voir colonne B).
Une autre solution utilisant la fonction ci-dessus. Cliquer sur le bouton Bleu.

Les codes sont dans Module1.

Bernard_XLD · 1 Novembre 2017

Bonjour le forum
une fonction personnalisée avec un tableau

Code:

Function Correspondance_Ident(Valeur_Code As String, Plage_Tab As Range)
Tab_Données = Plage_Tab.Value
For Compteur = LBound(Tab_Données) To UBound(Tab_Données)
    Valeur_Code = Replace(Valeur_Code, Tab_Données(Compteur, 1), Tab_Données(Compteur, 2))
Next Compteur
Correspondance_Ident = Replace(Valeur_Code, ",", "-")
End Function

Cordialement

Dranreb · 1 Novembre 2017

Bonjour.
Avec une seule constitution du Dictionary lors de la 1ère évaluation de la fonction après réinitialisation du projet VBA:

VB:

Option Explicit
Private DicABC As Dictionary

Function CodABC(ByVal X As String) As String
Dim T(), L As Long, TSpl() As String
If DicABC Is Nothing Then
   Set DicABC = New Dictionary
   T = Feuil1.Range(Feuil1.Cells(1, "A"), Feuil1.Cells(&H100000, 2).End(xlUp)).Value
   For L = 1 To UBound(T, 1): DicABC(CStr(T(L, 1))) = T(L, 2): Next L: End If
TSpl = Split(X, ",")
For L = 0 To UBound(TSpl)
   If DicABC.Exists(TSpl(L)) Then TSpl(L) = DicABC(TSpl(L))
   Next L
CodABC = Join(TSpl, ",")
End Function

(Avec référence Microsoft Scripting Runtime cochée)

Daybouk · 1 Novembre 2017

Jacky67 à dit:
Bonjour,
A tester le classeur en PJ

Bonjour Jacky67,

Merci pour votre réponse. Cela fonctionne ! Je débute en Macro et clairement, je n'aurai pas pu faire ça moi-même. Est-ce que vous auriez la gentillesse d'ajouter des commentaires dans le code pour expliquer la structure et ce que fait chaque instruction ? Ce serait top pour mon apprentissage et pour que je puisse l'adapter à mon tableau global.

Merci encore !

Daybouk · 1 Novembre 2017

mapomme à dit:
Bonjour Daybouk et bienvenue sur XLD , Jacky67, zebanx,

Un essai avec une fonction personnalisée (voir colonne B).
Une autre solution utilisant la fonction ci-dessus. Cliquer sur le bouton Bleu.

Les codes sont dans Module1.

Bonjour mapomme,

Merci encore. Par contre, j'ai un message d'erreur quand je lance la fonction ou que j'appuie sur le bouton bleu. Voir images en pj. Pouvez-vous m'aider ?

Merci.

Daybouk · 1 Novembre 2017

Yeahou à dit:

Bonjour le forum
une fonction personnalisée avec un tableau

Code:

Function Correspondance_Ident(Valeur_Code As String, Plage_Tab As Range)
Tab_Données = Plage_Tab.Value
For Compteur = LBound(Tab_Données) To UBound(Tab_Données)
    Valeur_Code = Replace(Valeur_Code, Tab_Données(Compteur, 1), Tab_Données(Compteur, 2))
Next Compteur
Correspondance_Ident = Replace(Valeur_Code, ",", "-")
End Function

Cordialement

Bonjour Yeahou,

Merci pour votre aide. Je suppose qu'il faut que j'enregistre cette fonction dans mon classeur de macros personnelles si je veux pouvoir y faire appel sur mes tableaux ?

Merci encore.

Daybouk · 1 Novembre 2017

Dranreb à dit:
Bonjour.
Avec une seule constitution du Dictionary lors de la 1ère évaluation de la fonction après réinitialisation du projet VBA:

VB:

Option Explicit Private DicABC As Dictionary Function CodABC(ByVal X As String) As String Dim T(), L As Long, TSpl() As String If DicABC Is Nothing Then Set DicABC = New Dictionary T = Feuil1.Range(Feuil1.Cells(1, "A"), Feuil1.Cells(&H100000, 2).End(xlUp)).Value For L = 1 To UBound(T, 1): DicABC(CStr(T(L, 1))) = T(L, 2): Next L: End If TSpl = Split(X, ",") For L = 0 To UBound(TSpl) If DicABC.Exists(TSpl(L)) Then TSpl(L) = DicABC(TSpl(L)) Next L CodABC = Join(TSpl, ",") End Function

(Avec référence Microsoft Scripting Runtime cochée)

Bonjour Dranreb,

Merci de votre aide.
Peut-être la réponse est-elle évidente mais je suis novice en matière de fonction personnalisée... Quels sont les arguments que je dois rentrer pour faire marcher cette fonction ? Merci !

mapomme · 2 Novembre 2017

Bonsoir,

Daybouk à dit:
onjour mapomme,

Merci encore. Par contre, j'ai un message d'erreur quand je lance la fonction ou que j'appuie sur le bouton bleu. Voir images en pj. Pouvez-vous m'aider ?

Je n'avais pas remarqué que vous utilisez un MAC. Or dans mon code, j'emploie un composant présent sous Windows mais absent de votre système d'exploitation. Donc ça ne marchera chez vous .

C'est la même réponse pour Dranreb.

Jacky67 · 2 Novembre 2017

Daybouk à dit:
Bonjour Jacky67,

Merci pour votre réponse. Cela fonctionne ! Je débute en Macro et clairement, je n'aurai pas pu faire ça moi-même. Est-ce que vous auriez la gentillesse d'ajouter des commentaires dans le code pour expliquer la structure et ce que fait chaque instruction ? Ce serait top pour mon apprentissage et pour que je puisse l'adapter à mon tableau global.

Merci encore !

En PJ le classeur avec le code commenté
Bon courage

mapomme · 2 Novembre 2017

Bonsoir Daybouk,

mapomme à dit:
Je n'avais pas remarqué que vous utilisez un MAC. Or dans mon code, j'emploie un composant présent sous Windows mais absent de votre système d'exploitation. Donc ça ne marchera chez vous .

Mais voici une version V2 qui devrait fonctionner sous Mac. Est ce le cas ?

Daybouk · 2 Novembre 2017

mapomme à dit:
Bonsoir Daybouk,

Mais voici une version V2 qui devrait fonctionner sous Mac. Est ce le cas ?

Merci ! Tout fonctionne maintenant.

Daybouk · 17 Novembre 2017

Est-ce que l'un de vous sait comment insérer un #NA par exemple lorsqu'on ne trouve pas la correspondance (code inconnu) ?

Daybouk · 17 Novembre 2017

Bonjour,
Est-ce que vous savez comment insérer les caractères #NA lorsqu'on ne trouve pas la correspondance ? Ex : code inconnu ne faisant pas partie du tableau de référence ?
Merci encore !

@mapomme
@Jacky67
@Dranreb
@Yeahou
@zebanx

Rechercher remplacer dans chaîne de caractères

Daybouk

XLDnaute Nouveau

Pièces jointes

Jacky67

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

Bernard_XLD

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

Daybouk

XLDnaute Nouveau

Daybouk

XLDnaute Nouveau

Pièces jointes

Daybouk

XLDnaute Nouveau

Daybouk

XLDnaute Nouveau

mapomme

XLDnaute Barbatruc

Jacky67

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

Daybouk

XLDnaute Nouveau

Daybouk

XLDnaute Nouveau

Daybouk

XLDnaute Nouveau

Discussions similaires