Remplacements caracteres

[zilio]

Re bonjour je poursuit toujours la même remplacer les caractères dans une feuille excel avec une feuille de correspondance des anciens caractères et des nouveau caractères.
voici le code qu'il m' a été proposé et que j'ai essayé mais ne marche pas:
petite précision je ne connais rien en programmation


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Or Target.Column = 2 Then
Set c = Sheets("correspondances").Range("B2:B" & Sheets("correspondances").Range("B65536").End(xlUp).Row).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Application.EnableEvents = False
Target.Value = c.Offset(0, -1)
Application.EnableEvents = True
End If
End If
End Sub
merci pour toute vous proposition

 

[tototiti2008]

Re : Remplacements caracteres

Bonjour zilio,

en lisant le code, il semblerait que si tu tapes un texte dans la feuille où se trouve ce code en colonnes A ou B, il aille chercher dans la colonne B de la feuille Correspondances le texte tapé, et s'il le trouve, il remplace le texte tapé par sa correspondance en colonne A de la feuille Correspondances

En me relisant je ne sais pas trop si c'est français, mais dis-moi si ce n'est pas clair
Et si c'est compréhensible, peut-être as-tu une idée du pourquoi ça ne fonctionne pas comme tu veux

Maintenant, avec un petit bout de fichier exemple et une explication claire de ce que tu souhaiterais que ça fasse, on irait sans doute plus vite

 

[aalex_38]

Re : Remplacements caracteres

bonjour,

Regarde du côté de la fonction REPLACE, cela devrait te convenir

Un exemple perso à adpater :

Sub Selection_Feuille_addin()
On Error GoTo fin
Dim RRange As Range

Set RRange = Selection
If RRange Is Nothing Then GoTo fin
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim Montab As Variant, cmpt1 As Long, cmpt2 As Long

If RRange.Count = 1 Then 'Pour 1 sinon KO pour une seule selection
    ReDim Montab(1 To 1, 1 To 1)
    Set Montab(1, 1) = RRange
Else
    Montab = RRange.Value
End If

For cmpt1 = LBound(Montab, 1) To UBound(Montab, 1)
For cmpt2 = LBound(Montab, 2) To UBound(Montab, 2)
' Lettres accentuées minuscules
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "à", "a", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "á", "a", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "â", "a", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ã", "a", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ä", "a", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "å", "a", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "æ", "ae", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "œ", "oe", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ç", "c", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "è", "e", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "é", "e", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ê", "e", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ë", "e", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ì", "i", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "í", "i", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "î", "i", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ï", "i", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ð", "o", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ñ", "n", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ò", "o", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ó", "o", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ô", "o", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "õ", "o", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ö", "o", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ø", "o", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ù", "u", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ú", "u", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "û", "u", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ü", "u", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ý", "y", , , vbTextCompare)
    Montab(cmpt1, cmpt2) = Replace(Montab(cmpt1, cmpt2), "ÿ", "y", , , vbTextCompare)
' Minuscules en majuscules
    Montab(cmpt1, cmpt2) = UCase(Montab(cmpt1, cmpt2))
Next cmpt2
Next cmpt1

    RRange.Value = Montab

' Application.CutCopyMode = False

fin:
Set Montab = Nothing: Set RRange = Nothing
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[Efgé]

Re : Remplacements caracteres

Bonjour zilio, aalex_38n, Bonjour tototiti ,

aalex_38n, il aurait été préférable de soit, continuer sur le premier fil, soit mettre ton fichier exemple....
Après consultation de rûnes magiques par le chaman de mon vilage, une proposition:

Private Sub CommandButton1_Click()
For Each C In Sheets("Exemple").UsedRange
    Set F = Sheets("correspondances").Range("B2:B6").Find(C.Value, LookIn:=xlValues)
    If Not F Is Nothing Then C.Value = F.Offset(0, -1).Value
Next C
End Sub

Cordialement
EDIT A bien y regarder il ne s'agit que de la transposition de la macro de Pierrejean en procédure de bouton. alors que la sienne était evennementielle.
Pas fait exprès, désolé.