Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

M

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"...
Trier par date Trier par votes

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
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:
Vote positif 0 Vote négatif
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+
 
Vote positif 0 Vote négatif

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
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
 
Vote positif 0 Vote négatif
Solution
M

Mak_tarmak

XLDnaute Junior
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,
 
Vote positif 0 Vote négatif
M

Mak_tarmak

XLDnaute Junior
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,
 
Vote positif 0 Vote négatif

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
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:
Vote positif 0 Vote négatif

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
re,

Mak_tarmak à dit:
Je suis impressionné du différence de nombres de lignes entre ta macro et la mienne.
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
M

Mak_tarmak

XLDnaute Junior
Merci c'est génial la programmation !
 
Vote positif 0 Vote négatif
M

Mak_tarmak

XLDnaute Junior
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, @+
 
Vote positif 0 Vote négatif

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
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:
Vote positif 0 Vote négatif
M

Mak_tarmak

XLDnaute Junior
Merci,
Très astucieux, on sent qu'il y a du vécu
Je testerai demain au boulot.

Bonne soirée, @+
 
Vote positif 0 Vote négatif

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
Bonjour le fil, le forum

Mak_tarmak à dit:
Je suis sur Office 2010 mais tu indiques que cela fonctionne sur toutes les versions.
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif
M

Mak_tarmak

XLDnaute Junior
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, @+
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

J
  • Question
XL 2013 Boucle : copie valeur d'une table dans un autre onglet jusqu'à cellule non vide
Réponses
4
Affichages
376
jerome91
J
C
  • Question
XL 2010 MsgBox selon la valeur d'une cellule
Réponses
2
Affichages
449
CATPLUS
C
S
  • Résolu(e)
Microsoft 365 - Conseils pour la structuration d'une base de données -
2 3
Réponses
44
Affichages
3 K
crocrocro
C
J
  • Question
XL 2010 définir un nom de cellule en fonction de la valeur d'une autre
Réponses
12
Affichages
796
jojo4738
J
P
  • Question
XL 2016 identifier chaine de caractère dans une cellule et ramener une donnée d'une table de correspondance
Réponses
5
Affichages
535
pmid20
P
Y
  • Question
Boucle pour trouver la valeur minimale
Réponses
3
Affichages
419
sylvanu
X
  • Question
XL 2010 copier la valeur d'une cellule, si date du jour correspond à la date de la colonne...
Réponses
1
Affichages
574
djidji59430
Z
  • Question
XL 2021 InputBox and focus à la fin de la ligne d'une valeur par défaut
Réponses
4
Affichages
269
zedude
Z
I
  • Résolu(e)
Microsoft 365 Exécuter une macro en fonction de la valeur d'une cellule
Réponses
12
Affichages
346
iliess
I
A
  • Question
XL 2021 récupérer la valeur d'une variable en fin de boucle dans une autre procédure
Réponses
5
Affichages
394
Attila451
A
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…