XL 2010 Boucle pour remplacer la valeur d'une cellule par la valeur d'une table de correspondance

Mak_tarmak

XLDnaute Junior
Bonjour,
Je commence à m'intéresser aux macros vba et je cherche à optimiser une macro que j'ai enregistré.
Dans le fichier ci-joint il y a l'onglet tableau qui contient des salles dont il faut épurer le nom grâce à la table de correspondance qui se trouve dans l'onglet salles.
Les noms corrects se trouvent dans la colonne B de ce dernier onglet.
La macro "remplacerSalles" fonctionne mais est trop longue. Je cherche donc à l'optimiser.
Pourriez-vous me conseiller sur la boucle à utiliser ? et comment gérer les erreurs quand une salle ne se trouve pas la liste à remplacer dans l'onglet tableau ?
Merci pour votre aide,
 

Pièces jointes

  • Boucle_SALLES .xlsm
    44.2 KB · Affichages: 18
Solution
Re Mak_tarmak, bonjour Bruno

Sinon, en plus optimisé, celle la est encore quatre fois plus rapide, 4 centièmes de secondes sur 10000 valeurs, avec une seule passe par replace mais il faut rester dans la limite de transpose de 65536 valeurs max à modifier, ce qui laisse quand même de la marge.

Bien cordialement, @+
VB:
Sub remplacerSalles3()
Dim Tablo, Tablo2, y&
With Sheets("Salles")
    Tablo = .Range("A2:B" & .Range("A65536").End(xlUp).Row).Value2
End With
With Sheets("tableau")
    Tablo2 = Join(Application.Transpose(.Range("A2:A" & .Range("A65536").End(xlUp).Row).Value2), "|")
End With
For y = LBound(Tablo, 1) To UBound(Tablo, 1)
    Tablo2 = Replace(Tablo2, Tablo(y, 1), Tablo(y, 2))
Next y
With Sheets("tableau")
    .Range("A2:A"...
Bonjour Mak_tarmak

Cette petite macro, avec des tableaux VB, fera le travail plus rapidement.

Bien cordialement, @+
VB:
Sub remplacerSalles()
Dim Tablo, Tablo2, x&, y&
With Sheets("Salles")
    Tablo = .Range("A2:B" & .Range("A65536").End(xlUp).Row).Value2
End With
With Sheets("tableau")
    Tablo2 = .Range("A2:A" & .Range("A65536").End(xlUp).Row).Value2
End With
For x = LBound(Tablo2, 1) To UBound(Tablo2, 1)
    For y = LBound(Tablo, 1) To UBound(Tablo, 1)
        Tablo2(x, 1) = Replace(Tablo2(x, 1), Tablo(y, 1), Tablo(y, 2))
    Next y
Next x
With Sheets("tableau")
    .Range("A2:A" & .Range("A65536").End(xlUp).Row).Value = Tablo2
End With
End Sub
 
Dernière édition:
C

Compte Supprimé 979

Guest
Bonjour le fil, Yeahou

J'avais également travaillé sur le sujet, je mets mon code moins optimisé 😜
VB:
Option Explicit

Sub RemplacerSalles_v2()
  Dim dLig As Long, Lig As Long
  Dim TabS() As Variant, TabT() As Variant
  Dim Ind As Long
  '
  With Sheets("Salles")
    ' Dernière ligne remplie
    dLig = .Range("B" & Rows.Count).End(xlUp).Row
    ' Définir le tableau des correspondances
    TabS = .Range("A2:B22").Value
  End With
  With Sheets("tableau")
    ' Dernière ligne remplie
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Définir le tableau des salles
    TabT = .Range("A2:B" & dLig).Value
    ' En cas d'erreur
    On Error Resume Next
    ' Parcourir chaque salle
    For Lig = 1 To dLig - 1
      ' Trouver l'indice de la correspondance
      Ind = Application.Match(TabT(Lig, 1), Application.Index(TabS, , 1), 0)
      ' Inscrire la correspondance dans le tableau des salles
      If Ind > 0 Then TabT(Lig, 2) = TabS(Ind, 2)
    Next Lig
    ' Isncrire la colonne 2 du tableau des salles
    .Range("B2:B" & dLig).Value = Application.Index(TabT, , 2)
    ' Petit message
    MsgBox "C'est fini... oui déjà ;-)", vbInformation, "RAPIDE..."
  End With
End Sub

A+
 
Re Mak_tarmak, bonjour Bruno

Sinon, en plus optimisé, celle la est encore quatre fois plus rapide, 4 centièmes de secondes sur 10000 valeurs, avec une seule passe par replace mais il faut rester dans la limite de transpose de 65536 valeurs max à modifier, ce qui laisse quand même de la marge.

Bien cordialement, @+
VB:
Sub remplacerSalles3()
Dim Tablo, Tablo2, y&
With Sheets("Salles")
    Tablo = .Range("A2:B" & .Range("A65536").End(xlUp).Row).Value2
End With
With Sheets("tableau")
    Tablo2 = Join(Application.Transpose(.Range("A2:A" & .Range("A65536").End(xlUp).Row).Value2), "|")
End With
For y = LBound(Tablo, 1) To UBound(Tablo, 1)
    Tablo2 = Replace(Tablo2, Tablo(y, 1), Tablo(y, 2))
Next y
With Sheets("tableau")
    .Range("A2:A" & .Range("A65536").End(xlUp).Row).Value = Application.Transpose(Split(Tablo2, "|"))
End With
End Sub
 

Mak_tarmak

XLDnaute Junior
Re Mak_tarmak, bonjour Bruno

Sinon, en plus optimisé, celle la est encore quatre fois plus rapide, 4 centièmes de secondes sur 10000 valeurs, avec une seule passe par replace mais il faut rester dans la limite de transpose de 65536 valeurs max à modifier, ce qui laisse quand même de la marge.

Bien cordialement, @+
VB:
Sub remplacerSalles3()
Dim Tablo, Tablo2, y&
With Sheets("Salles")
    Tablo = .Range("A2:B" & .Range("A65536").End(xlUp).Row).Value2
End With
With Sheets("tableau")
    Tablo2 = Join(Application.Transpose(.Range("A2:A" & .Range("A65536").End(xlUp).Row).Value2), "|")
End With
For y = LBound(Tablo, 1) To UBound(Tablo, 1)
    Tablo2 = Replace(Tablo2, Tablo(y, 1), Tablo(y, 2))
Next y
With Sheets("tableau")
    .Range("A2:A" & .Range("A65536").End(xlUp).Row).Value = Application.Transpose(Split(Tablo2, "|"))
End With
End Sub
Bonjour Yeahou,
Un grand merci, tes macros fonctionnent très bien.
Je suis impressionné du différence de nombres de lignes entre ta macro et la mienne.
Je vais l'étudier en détails pour en apprendre plus.
Merci de ton aide,
Bien à toi,
 

Mak_tarmak

XLDnaute Junior
Bonjour le fil, Yeahou

J'avais également travaillé sur le sujet, je mets mon code moins optimisé 😜
VB:
Option Explicit

Sub RemplacerSalles_v2()
  Dim dLig As Long, Lig As Long
  Dim TabS() As Variant, TabT() As Variant
  Dim Ind As Long
  '
  With Sheets("Salles")
    ' Dernière ligne remplie
    dLig = .Range("B" & Rows.Count).End(xlUp).Row
    ' Définir le tableau des correspondances
    TabS = .Range("A2:B22").Value
  End With
  With Sheets("tableau")
    ' Dernière ligne remplie
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Définir le tableau des salles
    TabT = .Range("A2:B" & dLig).Value
    ' En cas d'erreur
    On Error Resume Next
    ' Parcourir chaque salle
    For Lig = 1 To dLig - 1
      ' Trouver l'indice de la correspondance
      Ind = Application.Match(TabT(Lig, 1), Application.Index(TabS, , 1), 0)
      ' Inscrire la correspondance dans le tableau des salles
      If Ind > 0 Then TabT(Lig, 2) = TabS(Ind, 2)
    Next Lig
    ' Isncrire la colonne 2 du tableau des salles
    .Range("B2:B" & dLig).Value = Application.Index(TabT, , 2)
    ' Petit message
    MsgBox "C'est fini... oui déjà ;-)", vbInformation, "RAPIDE..."
  End With
End Sub

A+
Bonjour Bruno,
Ta macro fonctionne nickel et merci de l'avoir commenté, m'aide à comprendre et à progresser.
J'ai essayé de modifier la colonne de sortie dans l'onglet tableau pour la passer de A en C pour voir si je comprenais bien ta macro mais je n'ai pas réussi.
Je pense qu'il faut agir sur dLig et TabT mais j'ai dû mal m'y prendre.
Est-ce que je ne suis pas loin ?
Encore un grand merci pour ton aide,
Bien à toi,
 
Re,

Les tableaux Vb travaillant en mémoire sont beaucoup plus rapides que le travail sur feuille.
Je te mets en pièce jointe ton classeur avec 10000 lignes, et la fonction que j'utilise pour tester le temps d'exécution, les nouvelles valeurs se mettent en colonne B et écrasent les précédentes.
J'ai commenté le code pour te faciliter la compréhension des deux macros
J'y ai mis aussi dans le fichier celle de Bruno ;) qui est de toute façon beaucoup, beaucoup plus rapide que l'original.

Bien cordialement, @+
VB:
Sub remplacerSalles_Yeahou()
Heu_Deb = Timer
Dim Tablo, Tablo2, x&, y&
With Sheets("Salles")
    Tablo = .Range("A2:B" & .Range("A65536").End(xlUp).Row).Value2 'on crée tablo à deux colonnes d'après les correspondances de valeurs à modifier
End With
With Sheets("tableau")
    Tablo2 = .Range("A2:A" & .Range("A65536").End(xlUp).Row).Value2 'on crée tablo2 à une colonne d'après les  valeurs à modifier
End With
For x = LBound(Tablo2, 1) To UBound(Tablo2, 1) 'on boucle sur les valeurs
    For y = LBound(Tablo, 1) To UBound(Tablo, 1) 'on boucle sur les correspondances
        Tablo2(x, 1) = Replace(Tablo2(x, 1), Tablo(y, 1), Tablo(y, 2)) ' on remplace dans la valeur de Tablo2 la valeur de Tablo colonne 1 par la correspondance en Tablo colonne2
    Next y
Next x
With Sheets("tableau")
    .Range("B2:B" & .Range("A65536").End(xlUp).Row).Value = Tablo2 ' on met les valeurs en colonne B
End With
MsgBox "Fini en " & Temps_Ecoule, vbOKOnly + vbInformation
End Sub


Sub remplacerSalles_YeahouV2()
Heu_Deb = Timer
Dim Tablo, Tablo2, y&
With Sheets("Salles")
    Tablo = .Range("A2:B" & .Range("A65536").End(xlUp).Row).Value2 'on crée tablo d'après les correspondances de valeurs à modifier
End With
With Sheets("tableau")
    Tablo2 = Join(Application.Transpose(.Range("A2:A" & .Range("A65536").End(xlUp).Row).Value2), "|") 'on crée dans Tablo2 une chaine texte unique avec chaque valeur séparée par "|", transpose recréant un tableau vb attaquable avec Join
End With
For y = LBound(Tablo, 1) To UBound(Tablo, 1)
    Tablo2 = Replace(Tablo2, Tablo(y, 1), Tablo(y, 2)) ' on boucle sur les correspondances de valeur en remplaçant dans la chaine Tablo2
Next y
With Sheets("tableau")
    .Range("B2:B" & .Range("A65536").End(xlUp).Row).Value = Application.Transpose(Split(Tablo2, "|")) 'on rmet les valeurs en colonne B en coupant la chaine avec Split, le transpose recrée le tableau dimensionné comme à l'origine
End With
MsgBox "Fini en " & Temps_Ecoule, vbOKOnly + vbInformation
End Sub
 

Pièces jointes

  • Boucle_SALLES -1.xlsm
    153 KB · Affichages: 9
Dernière édition:
re,

Je suis impressionné du différence de nombres de lignes entre ta macro et la mienne.
Ma foi, si ce n'est que ça, on peut faire encore moins de lignes 🤣

Bonne journée ;)
VB:
Sub remplacerSalles_YeahouV3()
Heu_Deb = Timer
Dim Tablo, Tablo2, y&
Tablo = Sheets("Salles").Range("A2:B" & Sheets("Salles").Range("A65536").End(xlUp).Row).Value2 'on crée tablo d'après les correspondances de valeurs à modifier
Tablo2 = Join(Application.Transpose(Sheets("tableau").Range("A2:A" & Sheets("tableau").Range("A65536").End(xlUp).Row).Value2), "|") 'on crée dans Tablo2 une chaine texte unique avec chaque valeur séparée par "|", transpose recréant un tableau vb attaquable avec Join
For y = LBound(Tablo, 1) To UBound(Tablo, 1): Tablo2 = Replace(Tablo2, Tablo(y, 1), Tablo(y, 2)): Next y ' on boucle sur les correspondances de valeur en remplaçant dans la chaine Tablo2
Sheets("tableau").Range("B2:B" & Sheets("tableau").Range("A65536").End(xlUp).Row).Value = Application.Transpose(Split(Tablo2, "|")) 'on rmet les valeurs en colonne B en coupant la chaine avec Split, le transpose recrée le tableau dimensionné comme à l'origine
MsgBox "Fini en " & Temps_Ecoule, vbOKOnly + vbInformation
End Sub
 

Mak_tarmak

XLDnaute Junior
re,


Ma foi, si ce n'est que ça, on peut faire encore moins de lignes 🤣

Bonne journée ;)
VB:
Sub remplacerSalles_YeahouV3()
Heu_Deb = Timer
Dim Tablo, Tablo2, y&
Tablo = Sheets("Salles").Range("A2:B" & Sheets("Salles").Range("A65536").End(xlUp).Row).Value2 'on crée tablo d'après les correspondances de valeurs à modifier
Tablo2 = Join(Application.Transpose(Sheets("tableau").Range("A2:A" & Sheets("tableau").Range("A65536").End(xlUp).Row).Value2), "|") 'on crée dans Tablo2 une chaine texte unique avec chaque valeur séparée par "|", transpose recréant un tableau vb attaquable avec Join
For y = LBound(Tablo, 1) To UBound(Tablo, 1): Tablo2 = Replace(Tablo2, Tablo(y, 1), Tablo(y, 2)): Next y ' on boucle sur les correspondances de valeur en remplaçant dans la chaine Tablo2
Sheets("tableau").Range("B2:B" & Sheets("tableau").Range("A65536").End(xlUp).Row).Value = Application.Transpose(Split(Tablo2, "|")) 'on rmet les valeurs en colonne B en coupant la chaine avec Split, le transpose recrée le tableau dimensionné comme à l'origine
MsgBox "Fini en " & Temps_Ecoule, vbOKOnly + vbInformation
End Sub
Merci c'est génial la programmation ! :)
 

Mak_tarmak

XLDnaute Junior
Re,

Les tableaux Vb travaillant en mémoire sont beaucoup plus rapides que le travail sur feuille.
Je te mets en pièce jointe ton classeur avec 10000 lignes, et la fonction que j'utilise pour tester le temps d'exécution, les nouvelles valeurs se mettent en colonne B et écrasent les précédentes.
J'ai commenté le code pour te faciliter la compréhension des deux macros
J'y ai mis aussi dans le fichier celle de Bruno ;) qui est de toute façon beaucoup, beaucoup plus rapide que l'original.

Bien cordialement, @+
VB:
Sub remplacerSalles_Yeahou()
Heu_Deb = Timer
Dim Tablo, Tablo2, x&, y&
With Sheets("Salles")
    Tablo = .Range("A2:B" & .Range("A65536").End(xlUp).Row).Value2 'on crée tablo à deux colonnes d'après les correspondances de valeurs à modifier
End With
With Sheets("tableau")
    Tablo2 = .Range("A2:A" & .Range("A65536").End(xlUp).Row).Value2 'on crée tablo2 à une colonne d'après les  valeurs à modifier
End With
For x = LBound(Tablo2, 1) To UBound(Tablo2, 1) 'on boucle sur les valeurs
    For y = LBound(Tablo, 1) To UBound(Tablo, 1) 'on boucle sur les correspondances
        Tablo2(x, 1) = Replace(Tablo2(x, 1), Tablo(y, 1), Tablo(y, 2)) ' on remplace dans la valeur de Tablo2 la valeur de Tablo colonne 1 par la correspondance en Tablo colonne2
    Next y
Next x
With Sheets("tableau")
    .Range("B2:B" & .Range("A65536").End(xlUp).Row).Value = Tablo2 ' on met les valeurs en colonne B
End With
MsgBox "Fini en " & Temps_Ecoule, vbOKOnly + vbInformation
End Sub


Sub remplacerSalles_YeahouV2()
Heu_Deb = Timer
Dim Tablo, Tablo2, y&
With Sheets("Salles")
    Tablo = .Range("A2:B" & .Range("A65536").End(xlUp).Row).Value2 'on crée tablo d'après les correspondances de valeurs à modifier
End With
With Sheets("tableau")
    Tablo2 = Join(Application.Transpose(.Range("A2:A" & .Range("A65536").End(xlUp).Row).Value2), "|") 'on crée dans Tablo2 une chaine texte unique avec chaque valeur séparée par "|", transpose recréant un tableau vb attaquable avec Join
End With
For y = LBound(Tablo, 1) To UBound(Tablo, 1)
    Tablo2 = Replace(Tablo2, Tablo(y, 1), Tablo(y, 2)) ' on boucle sur les correspondances de valeur en remplaçant dans la chaine Tablo2
Next y
With Sheets("tableau")
    .Range("B2:B" & .Range("A65536").End(xlUp).Row).Value = Application.Transpose(Split(Tablo2, "|")) 'on rmet les valeurs en colonne B en coupant la chaine avec Split, le transpose recrée le tableau dimensionné comme à l'origine
End With
MsgBox "Fini en " & Temps_Ecoule, vbOKOnly + vbInformation
End Sub
Merci beaucoup d'avoir commenté ton code et d'avoir pris le temps de me faire un petit cours sur les tableaux ;)
Je n'ai pas réussi à exécuter les 3 macros car j'ai le message "projet ou bibliothèque introuvable" sur la fonction temps écoulé.
J'ai regardé les références dans VB et j'ai un manquant sur une librairie powerpoint mais je ne pense pas que cela vienne de là.
Je suis sur Office 2010 mais tu indiques que cela fonctionne sur toutes les versions.
J'ai peut-être oublier d'activer quelque chose. Une idée ?

Bien cordialement, @+
 
Re,

tu peux décocher la référence manquante qui ne sert à rien dans ce fichier.
quand j'ai pris ton fichier, mon excel 365 a upgradé la référence présente dans ton fichier mais excel 2010 n'arrive pas à faire l'inverse, cela m'est arrivé souvent quand j'avais 2016 à la maison et 2010 au boulot, parfois même le fichier plantait excel 2010 et il me fallait le remodifier sous 2016 pour qu'il veuille bien fonctionner sous 2010.
sinon copie les deux feuilles et les deux modules dans un classeur nouvellement créé sous ton 2010 et cela fonctionnera

Bien cordialement, @+
 
Dernière édition:

Mak_tarmak

XLDnaute Junior
Re,

tu peux décocher la référence manquante qui ne sert à rien dans ce fichier.
quand j'ai pris ton fichier, mon excel 365 a upgradé la référence présente dans ton fichier mais excel 2010 n'arrive pas à faire l'inverse, cela m'est arrivé souvent quand j'avais 2016 à la maison et 2010 au boulot, parfois même le fichier plantait excel 2010 et il me fallait le remodifier sous 2016 pour qu'il veuille bien fonctionner sous 2010.
sinon copie les deux feuilles et les deux modules dans un classeur nouvellement créé sous ton 2010 et cela fonctionnera

Bien cordialement, @+
Merci,
Très astucieux, on sent qu'il y a du vécu :)
Je testerai demain au boulot.

Bonne soirée, @+
 
Bonjour le fil, le forum

Je suis sur Office 2010 mais tu indiques que cela fonctionne sur toutes les versions.
Ma foi j'utilise ce code de timer depuis très longtemps, depuis excel 97 en fait, et il a tourné sur toutes les versions successives, je l'utilise encore sans problème sous Excel 365 32 et 64.
J'ai retrouvé ce fil sur le premier forum Xld ou nous avions codé, avec Thierry, une évolution de mon premier timer, encore bien plus ancien, pour pouvoir gérer les centièmes de secondes. (en fait, avant cela, avec la vitesse des ordinateurs, je m'arrétais aux secondes qui étaient bien suffisantes, les codes mettant parfois plusieurs minutes pour s'exécuter), il date un peu (septembre 2004) mais je pense que tu reconnaitras facilement le code.
https://www.excel-downloads.com/thr...sur-la-duree-dune-procedure.24695/post-113694

Bonne journée et tiens moi au courant.
 

Mak_tarmak

XLDnaute Junior
Bonjour le fil, le forum


Ma foi j'utilise ce code de timer depuis très longtemps, depuis excel 97 en fait, et il a tourné sur toutes les versions successives, je l'utilise encore sans problème sous Excel 365 32 et 64.
J'ai retrouvé ce fil sur le premier forum Xld ou nous avions codé, avec Thierry, une évolution de mon premier timer, encore bien plus ancien, pour pouvoir gérer les centièmes de secondes. (en fait, avant cela, avec la vitesse des ordinateurs, je m'arrétais aux secondes qui étaient bien suffisantes, les codes mettant parfois plusieurs minutes pour s'exécuter), il date un peu (septembre 2004) mais je pense que tu reconnaitras facilement le code.
https://www.excel-downloads.com/thr...sur-la-duree-dune-procedure.24695/post-113694

Bonne journée et tiens moi au courant.
Bonjour Yeahou,
j'ai réussi à les faire fonctionner en décochant la librairie manquante.
Impressionnant ! 64 centièmes pour la moins rapide et 7 centièmes pour la plus rapide.
Et pour la mienne 1 seconde et 70 centièmes, rien à voir :)

Merci pour le lien pour le chrono, oui c'est compréhensible

ps : la notation y& c'est pour déclarer une variable ?

Merci pour ton aide et celle de Bruno,
Bonne journée, @+
 

Discussions similaires

Statistiques des forums

Discussions
315 093
Messages
2 116 137
Membres
112 668
dernier inscrit
foyoman