Comment remplacer des lettres par nom avec une macro ?

Résolu
capeo Messages postés 181 Date d'inscription   Statut Membre Dernière intervention   -  
capeo Messages postés 181 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

J'ai un tableau qui contient différentes valeurs comportant des lettres. Le format ayant changé, je dois remplacer ces lettres ou groupe de lettres par un nouvel identifiant. Ces lettres peuvent être uniques ou associées avec d'autres lettres qui sont séparées par un point virgule.

Nota : Les données à transformer sont dans la colonne A et la table de conversion n'est pas figée en nb de lignes.

je joins un petit fichier :https://www.cjoint.com/?3Botijy6BOk

Merci par avance
A voir également:

2 réponses

Gyrus Messages postés 3334 Date d'inscription   Statut Membre Dernière intervention   526
 
Bonsoir,

Une proposition de macro :
https://www.cjoint.com/c/EBouIdOmf3E

A+
0
capeo Messages postés 181 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour

J'ai omis un petit détail mais qui a toute son importance. Si j'ai des cellules vides la macro bug. Encore mille excuse car je réfléchissais en fonction recherchev. Je vois que pour les macros il faut en tenir compte.

y a t il moyen de corriger la macro. Merci

Cordialement
0
Gyrus Messages postés 3334 Date d'inscription   Statut Membre Dernière intervention   526
 
Bonjour,

Il suffit d'ajouter une instruction de test :

Sub Test()
Dim Cel As Range, C As Range
Dim i As Integer
Dim Tablo
Dim Texte As String
For Each Cel In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
If Cel <> "" Then
Tablo = Split(Cel, ";")
For i = 0 To UBound(Tablo)
Set C = Columns(3).Find(Tablo(i), , xlValues, xlWhole)
If Not C Is Nothing Then
Texte = Texte & C.Offset(0, 1) & ";"
End If
Next i
Cel.Offset(0, 1) = Left(Texte, Len(Texte) - 1)
Texte = ""
End If
Next Cel
End Sub


A+
0
capeo Messages postés 181 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour Gyrus

Mille mercis pour cette correction. je vais pouvoir la tester sur mon fichier lundi. tu m'enlèves une épine du pied.

Cdl
0