Remplacer un grand nombre de valeurs par des textes

Bonjour à tous !

Je souhaite pouvoir remplacer des prix (une centaine de prix allant de 0 € à 200 €) par des textes qui décrivent ces prix (par exemple si le prix = 0, le texte doit automatiquement apparaître comme étant : " RIEN", de même pour 200 € : Abo25)

J'ai trouvé une macro de remplacement toute simple que voici :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Chaine

Dim Recherche

Dim Resultat As String

Chaine = Split(Target.Text)

Resultat = ""

If UBound(Chaine) <> -1 Then

With Sheets("Feuil2").Range("A1:B10")

For cpt = 0 To UBound(Chaine)

Set Recherche = .Find(Chaine(cpt), lookat:=xlWhole)

If Not Recherche Is Nothing Then

Chaine(cpt) = Recherche.Offset(0, 1)

End If

If cpt = 0 Then

Resultat = Chaine(cpt)

Else

Resultat = Resultat & " " & Chaine(cpt)

End If

Next

Application.EnableEvents = False

Target = Resultat

Application.EnableEvents = True

End With

End If

End Sub

Mais évidemment, mes données me compliquent la tâche.

Je voudrais que certains prix indiquent clairement les numéros des abonnements (du style : 200 € = abo25 ; 135,45 = abo145 ect...) et que tous les autres prix qui ne rentrent pas dans ces abonnements ( par exemple 5 € = Numéro 102, 10 € = Numéro 254) indique un seul et même texte : NUMERO.

Pour mieux comprendre, voici un fichier type

Merci d'avance à tous ceux qui pourront m'éclairer !

Bonjour,

Dans quelle feuille et quelle colonne doit-on faire cela ?

A quoi servent les données en feuille 2 ? Ce sont les références prix et texte à utiliser ?

Dans la feuille 1 à la colonne O, les prix doivent être remplacés par les textes indiqués dans la feuille 2 ( Il y a en colonne A les prix et en B les textes)

Re,

Je remarque que les indications de prix dans la feuille 1 sont avec un point et dans la feuille 2 avec une virgule.

Correct ou pas dans votre fichier original ?

Bonjour,

Il s'agit d'une erreur de ma part.

Dans la feuille 2, il s'agit bien de points et non de virgules !

Re

Essaie avec ce code à placer dans un module dans l'éditeur VBA

Sub test()
Dim lg As Integer
Dim cel As Range
With Sheets("Feuil1")
For Each cel In .Range("O2:O" & .Range("O" & Rows.Count).End(xlUp).Row)
On Error Resume Next
    lg = Sheets("Feuil2").Columns("A:A").Find(cel.Value, LookIn:=xlValues, MatchCase:=True).Row
    If lg > 0 Then .Range("O" & cel.Row) = Sheets("Feuil2").Range("B" & lg): lg = 0
Next
End With
End Sub

Si ok, lors de ta réponse clique sur le V vert à coté du bouton EDITER pour cloturer le fil

Amicalement

J'ai essayé de le retranscrire dans mon développeur VBA.

Donc j'ai changé les feuilles (vu que c'est pas les mêmes, dans ma base données : C'est Clients qui possède les prix et Tarifs, les valeurs & texte)

J'ai également changé les colonnes O en N.

J'ai inséré le code dans un module avant de créer un bouton... Mais ça ne fonctionne pas.

Pourtant dans le document type, ça fonctionnait mais dans le vrai document pas vraiment.

re,

Si souci le mieux est de voir la structure du vrai fichier (sans données confidentielles)

En supposant que :

• Clients = Feuil1
• Tarifs = Feuil2
• N à la place de O

Le code devient :

Sub test()
Dim lg As Integer
Dim cel As Range
With Sheets("Clients")
For Each cel In .Range("N2:N" & .Range("N" & Rows.Count).End(xlUp).Row)
On Error Resume Next

    lg = Sheets("Tarifs").Columns("A:A").Find(cel.Value, LookIn:=xlValues, MatchCase:=True).Row
    If lg > 0 Then .Range("N" & cel.Row) = Sheets("Tarifs").Range("B" & lg)

Next
End With
End Sub

Amicalement

Merci beaucoup !