XL 2019 Remplacement de Mots / compte en série par VBA

[gloeckelsberg]

Bonjour,

le but est de remplacer une série de Mot/phrase par d'autre et de compte par d'autre.

à savoir dans le fichier joint :

Feuille "Original" remplacer dans la colonne E les comptes en recherchant chaque code de la feuille "Remplacement Compte" colonne A et remplacer les trouver par la colonne B

Idem pour les libellés :

Feuille "Original" remplacer dans la colonne F les comptes en recherchant chaque code de la feuille "Remplacement intitulé" colonne A et remplacer les trouver par la colonne B

je saurai le faire x fois avec la fonction ctrl+H mais pas de façon vba

merci d'avance
lucas

 

[vgendron]

Bonjour
manque le fichier

 

[gloeckelsberg]

Bonjour
manque le fichier

désolé je viens de le remettre je n'avais pas vu qu'il n'avait pas été pris il été trop volumineux j'ai du supprimer des lignes

 

[vgendron]

En retour ton fichier avec une macro que j'ai commentée pour expliquer

note1: ca se passe en une dizaine de secondes
note2: je pense qu'une solution Power Query serait plus performante (mais.. je ne connais pas assez)

 

[vgendron]

Cette macro à base de dictionnaire devrait etre plus rapide

il faut activer la référence "Microsoft scripting runtime"

Sub Remplace2()
debut = Time
Dim Tab_Intitulé() As Variant
Dim Tab_Compte() As Variant
Dim Tab_Original() As Variant
'Dim dico_Intit As New Dictionary
'Dim dico_Compte As New Dictionary

Set dico_Intit = CreateObject("Scripting.Dictionary")
Set dico_Compte = CreateObject("Scripting.Dictionary")
 

'on récupère les données à traiter
With Sheets("Remplacement intitulé") 'tableau des changements d'intitulé
    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row
    Tab_Intitulé = .Range("A2:B" & LastLine).Value
End With

With Sheets("Remplacement Compte") 'tableau des changements de compte
    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row
    Tab_Compte = .Range("A2:B" & LastLine).Value
End With

For i = LBound(Tab_Intitulé, 1) To UBound(Tab_Intitulé, 1) 'pour chaque intitulé
    clé = UCase(Tab_Intitulé(i, 1))
    Valeur = UCase(Tab_Intitulé(i, 2))
    If Not dico_Intit.Exists(clé) Then
        dico_Intit.Add clé, Valeur
    End If
Next i

For i = LBound(Tab_Compte, 1) To UBound(Tab_Compte, 1) 'pour chaque Compte
    clé = UCase(Tab_Compte(i, 1))
    Valeur = UCase(Tab_Compte(i, 2))
    
    If Not dico_Compte.Exists(clé) Then
        dico_Compte.Add clé, Valeur
    End If
Next i


With Sheets("Original") 'tableau à traiter dans la feuille "Original"
    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row
    Tab_Original = .Range("E2:F" & LastLine).Value
End With

For i = LBound(Tab_Original, 1) To UBound(Tab_Original, 1)
    'MsgBox dico_Intit.exists(Tab_Original(i, 2))
    If dico_Compte.Exists(Tab_Original(i, 1)) Then
        Tab_Original(i, 1) = dico_Compte(Tab_Original(i, 1))
    End If
    
    If dico_Intit.Exists(Tab_Original(i, 2)) Then
        Tab_Original(i, 2) = dico_Intit(Tab_Original(i, 2))
    End If
Next i
With Sheets("Original")
    .Range("E2").Resize(UBound(Tab_Original, 1), UBound(Tab_Original, 2)) = Tab_Original
End With
fin = Time
MsgBox Format(fin - debut, "hh/mm/ss")
End Sub