Rechercher remplacer dans chaîne de caractères

[Daybouk]

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]

Bonjour,
A tester le classeur en PJ

 

[mapomme]

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]

Bonjour le forum
une fonction personnalisée avec un tableau

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]

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

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]

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]

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]

Bonjour le forum
une fonction personnalisée avec un tableau

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]

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

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]

Bonsoir,

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]

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]

Bonsoir Daybouk,

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]

Bonsoir Daybouk,

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

Merci ! Tout fonctionne maintenant.

 

[Daybouk]

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]

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