XL 2019 Modifier un élément du texte par un autre

[Yassin9]

Bonjour,

J'espère que vous allez bien ?
J'aimerais savoir si vous aviez une macro permettant de modifier un élément d'un texte par un autre, par exemple ici modifier "YYYY" par "5 mm" entré dans la cellule en dessous de "valeur mesurée"

Cordialement,
Yassin

 

[sylvanu]

Bonjour Yassin,
Un essai en PJ avec :

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("K8")) Is Nothing Then
        [B7] = Replace([B7], "XXXX", Target)
    ElseIf Not Intersect(Target, Range("K11")) Is Nothing Then
        [B7] = Replace([B7], "YYYY", Target)
    ElseIf Not Intersect(Target, Range("K14")) Is Nothing Then
        [B7] = Replace([B7], "ZZZZ", Target)
    End If
Fin:
Application.ScreenUpdating = True
End Sub

C'est automatique, il suffit de modifier une des trois valeurs pour faire la modification.
Et la touche RAZ permet de remettre le texte initial avec :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin2
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("K17")) Is Nothing Then
        [B7] = "Sur le sous-ensemble PLN 2714 ING 2784 nous avons mesuré quelques valeur hors" & Chr(10) & "tolérance selon ITP N XXXX" & _
               Chr(10) & "Valeur mesurée:" & Chr(10) & "YYYY" & Chr(10) & "Deviation:" & Chr(10) & "ZZZZ"
    End If
Fin2:
End Sub

 

[Yassin9]

@sylvanu MERCI ENORMEMENT !!!

 

[Yassin9]

@sylvanu une petite question, si jamais j'ai un autre élément à modifier comme par exemple PLN 2714, ING 2784 par PLN 2715, ING 2785
que dois-je ajouter ou modifier stp ?

 

[sylvanu]

Re,
J'ai modifié la macro avec :

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("K2,K5,K8,K11,K14")) Is Nothing Then
        Chaine = [B7]
        Chaine = Replace(Chaine, "PPPP", [K2])
        Chaine = Replace(Chaine, "IIII", [K5])
        Chaine = Replace(Chaine, "XXXX", [K8])
        Chaine = Replace(Chaine, "YYYY", [K11])
        Chaine = Replace(Chaine, "ZZZZ", [K14])
        [B7] = Chaine
    End If
Fin:
Application.ScreenUpdating = True
End Sub

J'ai rajouté deux valeurs PLN et ING.
Il suffit maintenant de modifier une des 5 valeurs pour tout remettre à jour.

 

[Yassin59]

@sylvanu désolé de te déranger j'ai essayé de reproduire ton fichier sur mon fichier de travail mais je n'y arrive pas, peux-tu m'aider ?
Notamment le RAZ ( qu'est ce que ça représente ? est comment le dupliquer sur mon fichier ? )
Et pour modifier plusieurs textes en même temps comment procéder ?

PS : je n'ai pas réussi à me connecter à mon compte du coup j'ai du en récréer un.

 

[sylvanu]

Bonsoir,
Comme ID SAP est une très grande chaine, j'ai préféré créer une feuille Modèle (masquée) pour faire du copier/coller pour le clear. Voir PJ.

 

[Yassin9]

@sylvanu MERCI, par contre comment vous avez intégré le clear ? svp

 

[sylvanu]

Le Clear est une cellule quelconque, ici j'ai choisis arbitrairement K9.
Quand on clique sur une cellule quelconque, la macro Worksheet_SelectionChange s'éxécute.
On regarde si c'est K9 qui a été cliquée ( par : "If Not Intersect(Target, Range("K9")) Is Nothing Then" ), si c'est le cas on exécute le reste de la macro, sinon on sort.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin2
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("K9")) Is Nothing Then
        With Sheets("Modèle")
            .Range("C15:H46").Copy
            Range("C15:H46").Select
            ActiveSheet.Paste
        End With
        [A1].Select
    End If
Fin2:
End Sub

 

[Yassin9]

@sylvanu ok nickel, merci
Je pose beaucoup de question mais si jamais je souhaite ajouter un élément à modifier en plus je l'ajoute bien dans cette section de la partie feuille c'est ça ? :

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Not Intersect(Target, Range("C11,C12,C13,G11,G12,G13")) Is Nothing Then
Application.ScreenUpdating = False
[C15] = Replace([C15], "AAAA", [C11]) 'Titre du DMS:
[C15] = Replace([C15], "BBBB", [C12])
[C16] = Replace([C16], "AAAA", [C11]) 'Nom Fichier :
[C16] = Replace([C16], "BBBB", [C12])
[C18] = Replace([C18], "AAAA", [C11]) 'Titre NCR:
[C18] = Replace([C18], "BBBB", [C12])
'ID SAP C :
Chaine = [C19]
Chaine = Replace(Chaine, "AAAA", [C11])
Chaine = Replace(Chaine, "BBBB", [C12])
Chaine = Replace(Chaine, "CCCC", [C13])
Chaine = Replace(Chaine, "FFFF", [G11])
Chaine = Replace(Chaine, "GGGG", [G12])
Chaine = Replace(Chaine, "HHHH", [G13])
[C19] = Chaine
End If
Fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[sylvanu]

Exact, vous pouvez rajouter un "KKKK", en remettant à jour la macro dans la première ou la seconde partie.
Sans oublier de remettre à jour le modèle pour la réinitialisation par Clear.
( A noter que si vous insérer une ligne, par ex en 17 alors il faut reprendre toute la macro C18 deviendra C19, C19 deviendra C20, et toujours reprendre le modèle en conséquence. )

 

[job75]

Bonsoir Yassin9, sylvanu,

On peut utiliser des formules en C15 C16 C18 C19.

En C19 c'est plus compliqué car il faut couper le texte en 4 pour respecter la limite de 255 caractères.

A+

 

[Yassin59]

salut @job75 , du coup tu as decoupé le texte avec les : "&"
on est d'accord ?

="CH PLN "&C11&" ING "&C12&" STRAIGHTENING ISSUE

Problèmes de dressage
Sur le sous-ensemble N°"&C13&" PLN "&C11&" / ING "&C12&" nous avons identifié un défaut de planéité hors de la tolérance requise selon le plan de conception valide N°STB PH-934-5020,§4.6 ."&"

Valeur Nominale : FFFF mm/2m
Valeur Relevée : GGGG Valeurs hors tolérances allant de -6 à -12 avec la règle de 2m
Ecart : HHHH mm avec la règle de 2m hors tolerences

------------------------------------------------------------------"&"

CH PLN "&C11&" ING "&C12&" STRAIGHTENING ISSUE


On subassembly N°"&C13&" PLN "&C11&" / ING "&C12&" we have identified flatness defect out of requested tolerance according to valid design drawing STB-PH-5020 §4,6"&"

Nominal value : FFFF mm/2m
Measured value : GGGG value measured out of tolerance between -6mm and -12mm with a 2m ruler
Deviation : HHHH of tolerence"

 

[job75]

salut @job75 , du coup tu as decoupé le texte avec les : "&"
on est d'accord ?

Oui.

 

[Yassin59]

Oui.

Merci beaucoup