Remplacer une lettre dans une chaîne de caractère

Pexcel · 8 Mai 2020

Bonjour,
j'ai beau chercher et je n'arrive pas à mettre en forme mon code ...
j'ai une colonne avec des cellules remplis de codes de ce type
Z89663
E552
Q874Q87
G33699888
T6633T8899

Je voudrais détecter la première lettre et si la même lettre se trouve dans la chaîne la remplacer ex Q874Q87

VB:

   'Le premier argument "start" (2) permet de définir la position de départ de la recherche.
  
   'detecter premiere Lettre depart
   Dim lettreD As String
   lettreD = Left(Cels.Offset(0, 0).Value, 1) ' renvoie "Q"
  
   'MsgBox lettreD
  
   'on cherche position cette lettre dans la chaine qui vient derriere
  
   Dim position As Byte
  
  
  ' MsgBox InStr(2, Cels.Offset(0, 0).Value, "Q") 'renvoie 5
  
  position = InStr(2, Cels.Offset(0, 0).Value, lettreD)
  
  
   'MsgBox position
  
   Dim st As String
   Dim correction As String
  
  
   st = Cels.Offset(0, 0).Value
  
  
   Debug.Print st
  
  
   MsgBox st
       'Oups... une erreur de frappe sur 5° caractère...
    'Utilisons Mid pour la modifier
 
    
    Mid(st, position, 1) = ""
    
    
       correction = Mid(st, position, 1) = ""
  
   MsgBox correction ' renvoie faux ???
    
    
    
    Debug.Print st

Ici correction renvoie faux ???

Merci.

jmfmarques · 8 Mai 2020

Bonjour
Recommence, mais cette fois-ci en t'appliquant un peu :
1) la propriété offset d'un objet range sert à le décaler. range(....).offset(0,0) ne décale rien du tout est reste donc = range(....) tout court
2) à quoi de test la variable st ? puisqu'elle est au final cels.value
3) une expression du genre toto = titi = tata fait que toto ne peut qu'être une booléenne (true si titi = tata et false sinon)
4)
Mid(st, position, 1) = ""
cette forme d'utilisation de l'instruction (pas la fonction) Mid nécessite que la chaîne à remplacer et son remmplacement soient de même longueur.
5) regarde le résultat de :
msgbox mid("voilà",2)
Je te laisse t'y remettre de manière plus appliquée/

Pounet95 · 8 Mai 2020

Bonjour,
et salut jfmfmarques ( post apparu pendant que j'écrivais, pas avant ? )

Peut-être avec ceci ?
Même si la 1ère lettre n'est pas présente ensuite, il n'y a pas d'erreur
A adapter bien sûr !

VB:

Sub Remplace()
    Dim strMot  As String
    Dim L1      As String
    
    strMot = "Q484Q487"
    '1ère lettre
    L1 = Left(strMot, 1)
    'Remplacer dans le reste du mot
    strMot = L1 & Replace(Mid$(strMot, 2, Len(strMot) - 1), L1, "X")
    MsgBox strMot

End Sub

patricktoulon · 8 Mai 2020

bonjour
full option

VB:

Sub test()
    Dim chaine As String

    chaine = "Q484Q487Q588Q254"
    MsgBox Replace_2d_occ(chaine, "X")       'replace  le 2d caracteres identique au premier de la chaine

    chaine = "Q484Q487Q588Q254"
    MsgBox Replace_2d_occ(chaine, "X", True) 'replace  tout les  caracteres identiques au premier de la chaine

End Sub

Function Replace_2d_occ(chaine As String, char As String, Optional Alloccurence As Boolean)
    If Not Alloccurence Then
        If InStr(Mid(chaine, 2), Left(chaine, 1)) > 0 Then Mid(chaine, InStr(2, chaine, Left(chaine, 1)), 1) = char
    Else
        chaine = Left(chaine, 1) & Mid(Replace(chaine, Left(chaine, 1), char, 2), 2)
    End If
    Replace_2d_occ = chaine
End Function

jmfmarques · 8 Mai 2020

Re
les choses simples seraient-elles également victimes du confinement ? --->>

VB:

toto = "Q7777Q222222Q333Q"
MsgBox Left(toto, 1) & Replace(Mid(toto, 2), Left(toto, 1), "ce que l'on veut")

Ceci étant : j'aurais préféré voir d'abord Pexcel réagir

patricktoulon · 8 Mai 2020

bonjour @jmfmarques
Attention la tienne remplace tout les caractères identiques au premier
ce que je propose est les deux soit le 2d soit tous

jmfmarques · 8 Mai 2020

ce que je propose est les deux soit le 2d soit tous

Est-ce là la demande de Pexcel ?

job75 · 8 Mai 2020

Bonjour,

Pexcel à dit:
Je voudrais détecter la première lettre et si la même lettre se trouve dans la chaîne la remplacer

La remplacer par quoi ? Par le texte vide "" ? A priori pas besoin de VBA :

VB:

=SI(NBCAR(A2)-NBCAR(SUBSTITUE(A2;GAUCHE(A2);))>1;SUBSTITUE(A2;GAUCHE(A2););A2)

A+

job75 · 8 Mai 2020

Pour ceux qui ne jurent que par VBA le même principe est utilisé avec cette fonction :

VB:

Function Result(x$)
Result = Replace(x, Left(x, 1), "")
If Len(x) - Len(Result) < 2 Then Result = x
End Function

job75 · 8 Mai 2020

Fichiers (2) si l'on veut conserver la 1ère lettre (méthode de jmfmarques).

Pexcel · 8 Mai 2020

Bonsoir tout le monde,
je regarde toutes vos propositions !!! Merci beaucoup...

jmfmarques à dit:
Ceci étant : j'aurais préféré voir d'abord Pexcel réagir

Déslolé jmfmarques je travaillais aujourd’hui, les héros que l'on applaudit tous les soirs ils se nourrissent aussi ainsi que leurs patients ... je m' y colle !

jmfmarques · 8 Mai 2020

les héros que l'on applaudit tous les soirs ils se nourrissent aussi ainsi que leurs patients

J'en ai la visite à raison de 4 fois par jour (3 heures au total) et les assiste dans leurs tâches au chevet de mon épouse (et ce depuis 7 mois), mais contribue également à maintenir leur bonne humeur (blagues, etc ...) y compris lorsque les choses vont mal

Pexcel · 8 Mai 2020

Oups va falloir que je teste parce que j'aurai du mieux préciser sur mon post de départ ... que je voulais supprimer la deuxième lettre, la remplacer par du vide en fait comme dans mon code pas par une autre... et préserver la première lettre :/

job75 · 8 Mai 2020

C'est bien ce qui se passe au post #10.

Pexcel · 9 Mai 2020

Merci @ tous pour votre aide ! je garde vos fichiers, ils me servent de cours pour progresser !
Je me sers de la solution de Job75 #10...
Protéger vous ! Bon Week End

Remplacer une lettre dans une chaîne de caractère

Pexcel

XLDnaute Junior

jmfmarques

XLDnaute Accro

Pounet95

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

jmfmarques

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

jmfmarques

XLDnaute Accro

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Pexcel

XLDnaute Junior

jmfmarques

XLDnaute Accro

Pexcel

XLDnaute Junior

job75

XLDnaute Barbatruc

Pexcel

XLDnaute Junior

Discussions similaires