Comment accélérer une mise à jour et limiter la zone de recherche - VBA
Bonjour,
Je voudrais accélérer le temps d'exécution de mes macro.
En effet le fichier base de Données sera composé d'environ 50 000 lignes et il devra trouver les informations (prix, conditionnement, etc ... ) dans environ 120 fichiers annexes. Je ne peux pas dévoiler les fichiers mais voici la macro.
Par exemple sur un des fichiers:
Fournisseur = fichier fournisseur
La colonne U est la colonne du fichier Donnees sur laquelle se trouve la clef de recherche
La colonne L est la colonne du fichier Fournisseur sur laquelle on retrouve la clef de recherche
La colonne X est la colonne du fichier Donnees sur laquelle on doit rapatrier le prix
La colonne R est la colonne du fichier Fournisseur sur la laquelle on trouve le prix
Sub essai()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.calculation=Xlmanual
Dim Ligne1 As Long, ligne2 As Long
ligne2 = Sheets("Donnees").Range("A17000").End(xlUp).Row
Ligne1 = Sheets("Fournisseur").Range("A2500").End(xlUp).Row
For n = 1 To ligne2
For m = 1 To Ligne1
If Sheets("Donnees").Range("U" & n) = Sheets("Fournisseur").Range("L" & m) Then
Sheets("Donnees").Range("X" & n) = Sheets("Fournisseur").Range("R" & m)
End If
Next
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.calculation= Xlautomatic
End SubEst-ce qu'il y a un moyen d'accélérer grandement cette recherche ?
Est-ce qu'il y a un moyen de mieux sélectionner les colonnes qui nous intéresse ?
Si je sélectionne dans le fichier Données le fournisseur en question, est-ce qu'il est possible d'accélérer la mise à jour ? (si oui par quel code)
Je ne suis pas spécialement attaché au VBA mais je voudrais absolument mettre en place un bouton et y rattacher formule (ou codes) qui mettra à jour tout ou partie du fichier. Vous l'avez compris je suis novice et complétement ouvert à de nouvelles méthodes (avec explications svp)
Bonjour,
Essayez ceci
Sub essai()
Application.ScreenUpdating = False
Dim f1 As Worksheet, f2 As Worksheet
Dim DerLig_f1 As Long, DerLig_f2 As Long
Set f1 = Sheets("Donnees")
Set f2 = Sheets("Fournisseur")
DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
f1.Range("X2:X" & DerLig_f1).FormulaR1C1 = "=IFERROR(INDEX(" & f2.Name & "!R1C12:R" & DerLig_f2 & "C18,MATCH(Donnees!RC21," & f2.Name & "!R1C12:R" & DerLig_f2 & "C12,0),7),"""")"
f1.Range("X2:X" & DerLig_f1).Value = f1.Range("X2:X" & DerLig_f1).Value
Set f1 = Nothing
Set f2 = Nothing
End SubCdlt
Bonjour Arturo83
Merci pour ta réponse.
1) Pourrais-tu m'expliquer les lignes suivantes svp
f1.Range("X2:X" & DerLig_f1).FormulaR1C1 = "=IFERROR(INDEX(" & f2.Name & "!R1C12:R" & DerLig_f2 & "C18,MATCH(Donnees!RC21," & f2.Name & "!R1C12:R" & DerLig_f2 & "C12,0),7),"""")"
f1.Range("X2:X" & DerLig_f1).Value = f1.Range("X2:X" & DerLig_f1).Value
2) Je vois C12 et !R1C12:R ? Qu'est-ce que c'est ?
Un grand merci à toi
Bonjour,
f1.Range("X2:X" & DerLig_f1).FormulaR1C1 = "=IFERROR(INDEX(" & f2.Name & "!R1C12:R" & DerLig_f2 & "C18,MATCH(Donnees!RC21," & f2.Name & "!R1C12:R" & DerLig_f2 & "C12,0),7),"""")"
C'est tout simplement équivalent à la formule suivante appliquée à toutes les lignes:
=SIERREUR(INDEX(Fournisseur!$L$1:$R$1;EQUIV(Donnees!$U2;Fournisseur!$L$1:$L$1;0);7);"")************************************************************************************************************************************************
f1.Range("X2:X" & DerLig_f1).Value = f1.Range("X2:X" & DerLig_f1).Value
Cette ligne écrase les formules précédentes pour ne conserver que les valeurs.
************************************************************************************************************************************************
Je vois C12 et !R1C12:R ? Qu'est-ce que c'est ?
R1 =Row1=Ligne 1
C12=Column12 = colonne 12 ou colonne L
et enfin R" & DerLig pour la dernière ligne de la colonne 12 (L)
************************************************************************************************************************************************
Moi, j'aurai aimé savoir si cela fonctionnait bien, et si c'est le cas, passez le sujet en "Résolu"
Cdlt
Bonjour,
Merci pour votre post
Non cela ne marche pas mais je dois faire quelques de mal mais je ne sais pas quoi.
Afin d'améliorer les choses, j'ai mis un exemple (naturellement les données/prix sont faux)
L'objectif est de rapatrier le prix
Dans l'onglet H, il faudrait rapatrier le prix le plus élevé.
Il faut s'imaginer qu'il y aurait une centaine de tarifs
Merci pour votre aide
Bonjour,
C'est sûr que cela ne peut pas marcher, on est loin de la demande initiale.
- La notion d'extraire la prix le plus élevé n'était pas spécifié.
- Sur 3 fournisseurs, donc 3 feuilles, il n'y a pas deux structures identiques, "pas le même nombre de colonnes", "références et prix pas au même emplacement".
Donc, si toutes les feuilles fournisseurs sont dans le même style, il faut pas s'étonner que cela mette un certain pour l'exécution.
Je pense que dans un premier temps, pour chaque fournisseur, il faudra créer 2 colonnes, 1 pour la référence et 1 pour le prix récupérés par formule et placées dans une zone commune à toutes les feuilles et qui n'affectera aucun fournisseur (exemple: en colonnes "AY:AZ" ou autres ) ainsi toutes les feuilles auront la même structure, au moins pour ces 2 éléments.
A partir de là, on pourra peut-être faire quelque chose de correct et efficace.
Cdlt
Bonjour Arturo83
Tout d'abord merci pour ces conseils.
Deux remarques importantes
1) J'aurais voulu toucher le moins possible aux différents fichiers fournisseurs. Plus on touche aux fichiers, plus le risque d'erreur est élevé.
- Seraient-ils possible de faire une macro par fichier et un bouton qui généralise une ou plusieurs macro (avec un temps d'exécution des macro "correct") ?
J'aurais aimé que la base de donnée se mette à jour automatiquement à partir des fichiers fournisseurs sans retouche.
Est-ce possible ?
2) Sinon (mais j'insiste je privilégie l'option numéro 1 car le risque d'erreur est moindre) est de créer une format de tarif commun à tous les fournisseurs mais cela nous fait faire une manipulation.
- Est-ce que l'on peut automatiser la mise à jour du listing articles commun avec les données fournisseur ?
Comme cela il "suffirait de compiler" les listing articles des différents fournisseur pour remplir la base de données.
Est-ce que cette étape pourrait être faite par des macro ?
Merci à vous
Bonjour,
Quand je disais qu'il fallait créer 2 colonnes : 1 pour la référence et 1 pour le prix", je voulais dire "Créée via le code VBA" et dans une zone libre et commune à tous ces fichiers, le temps de faire les calculs, puis une fois terminé, on supprime ces colonnes, ainsi on ne touche pas aux différents fichiers des fournisseurs.
Je pense que c'est à votre portée.
Cdlt
Bonjour,
Si j'ai bien compris, on créé deux colonnes dans les tarifs fournisseurs aux même numéros de colonne ?
Et pour le code ?
Excusez-moi si vous trouvez mes questions un peu bêtes mais je ne veux pas faire d'impair
Merci à vous
Bonjour,
Voici le fichier, j'ai créé une feuille "Liste_des_fournisseurs", puisque les feuilles "fournisseurs" sont toutes différentes, faite ce qui suit:
En colonne "A", mettez la liste de tous les fournisseurs
En colonne "B", mettez le N° de la colonne correspondant à la référence pour ce fournisseur
En colonne "C", mettez le N° de la colonne correspondant au prix pour ce fournisseur
Ceci afin d'éviter toute erreur entre chaque feuille et aussi pour faciliter la vitesse d'exécution.
Otez-moi d'un doute, la clé des références est bien unique pour chaque produit, et ne peut avoir des prix différents? parce que je vois pour le "fournisseur H", 3 prix différents pour une clé unique.
Cdlt
bonjour Arturo83, Lewis1975,
avec autofilter et agregat ...
Sub Recup_Donnees_BSALV()
Dim aA, cOut, aOut, c As Range, MyMax
t = Timer
Set sh = Sheets("Donnees") 'cette feuille
aA = sh.Range("A1").CurrentRegion.Value2 'matrice avec les données
Set cOut = sh.Range("A1").CurrentRegion.Columns(24) 'plage où les nouveaux prix seront inscrit
ReDim aOut(1 To UBound(aA), 1 To 1) 'valeurs actuelles des prix
aOut(1, 1) = aA(1, 24)
For i = 2 To UBound(aA) 'boucles les lignes de "Données"
If InStr(1, s, "|" & aA(i, 18) & "|", 1) = 0 Then 'un nouveau fournisseur unique ?
s = s & "|" & aA(i, 18) & "|" 'string avec les noms uniques des feuilles
On Error Resume Next
Set c = Nothing: Set c = Sheets(CStr(aA(i, 18))).Range("A1").CurrentRegion.Resize(, 30) 'la plage des données d'un fournisseur
On Error GoTo 0
If c Is Nothing Then
MsgBox "no feuille fournisseur " & aA(i, 18)
Else
c.AutoFilter 'RAZ autofilter
For Each el In Array("Référence", "Référence Tarif", "CODE ARTICLE", "N° CODE") 'matrice avec tous les noms possible de la colonne de référence des fournisseurs
Col_Ref = Application.Match(el, c.Rows(1), 0) 'cherche colonne de Référence
If IsNumeric(Col_Ref) Then Exit For
Next
For Each el In Array("Prix Tarif", "TARIF", "PRIX") 'matrice avec tous les noms possible de la colonne des prix des fournisseurs
Col_Prix = Application.Match(el, c.Rows(1), 0) 'cherche colonne des prix
If IsNumeric(Col_Prix) Then Exit For
Next
If Not IsNumeric(Col_Ref) Or Not IsNumeric(Col_Prix) Then
MsgBox "problème avec la colonne de référence ou du prix", vbCritical, "feuille " & aA(i, 18)
Else
For i1 = i To UBound(aA)
If aA(i1, 18) = aA(i, 18) Then 'même nouveau fournisseur
c.AutoFilter Col_Ref, aA(i1, 19) 'autofilter avec votre référence
MyMax = Application.WorksheetFunction.Aggregate(14, 7, c.Columns(Col_Prix), 1) 'le max des valeurs visibles non-erronnés
If IsNumeric(MyMax) Then aOut(i1, 1) = MyMax Else aOut(i1, 1) = "???" '
End If
Next
c.AutoFilter
End If
End If
End If
Next
cOut.Value = aOut 'écrire le résultat dans la bonne colonne
MsgBox "prêt en " & Format(Timer - t, "0.00\s") & vbLf & Format(UBound(aA), "#,###") & " lignes"
End SubBonjour Arturo83, bonjour BsAlv,
Merci pour votre soutien, un grand bravo à vous. Je suis en train d'étudier ce que vous avez fait.
Petite question BsAlv sur ces lignes:
If InStr(1, s, "|" & aA(i, 18) & "|", 1) = 0 Then 'un nouveau fournisseur unique ?
s = s & "|" & aA(i, 18) & "|" 'string avec les noms uniques des feuilles
On Error Resume Next
Comment et où as-tu défini "I" ?
Merci beaucoup
Bonjour Arturo83, bonjour Lewis1975,
ce "|" est un séparateur, on peut le remplacer par n'importe quel autre charactère qui ne sera jamais dans le nom d'un des fournisseurs, donc un virgule (avec des doutes), un ~, \, §, [, ], etc sont aussi bien. Le but était de traiter fournisseur par fournisseur pour gagner un petit peu de temps. Je ne sais pas le nombre de fournisseurs et le nombre de fournisseurs uniques dans votre recherche, Une fois qu'on a trouvé les 2 colonnes nécessaires de la feuille du fournisseur, la macro traite tous les articles du fournisseur est ne doit plus faire ce recherche de nouveau.
Chaque autre méthode (par exemple un dictionaire, collection, matrice, ...) pour détecter ce fournisseur unique est aussi bien, vous avez une préférence ?
Exemple on a déjà eu les fournisseurs "Fourn. AA", "Fourn. B", Fourn. C", donc le s = "|Fourn. AA||Fourn. B||Fourn. C|" et on a maintenant un nouveau forunisseur avec un nom qui est une partie d'un nom qu'on a déjà eu, cad "Fourn. A". Si on fait on recherche sans séparateur (ici le "|"), le "Instr" dit qu'on a déjà eu ce nom, mais s'il y a les séparateurs autour, cela n'est plus le cas.
Bonjour BsAlv,
Merci pour ta réponse, j'aimerai bien maîtriser VBA aussi bien que toi.
Petite question je fais le calcul avec de plus en plus de données mais je rencontre des problèmes.
Par exemple il y a une erreur qui arrive et qui est la suivante:
Erreur d'exécution 1004
Impossible de lire la propriété Aggregate de la classe WorksheetFunction
Cette erreur arrive au niveau de la ligne ci-dessous
MyMax = Application.WorksheetFunction.Aggregate(14, 7, c.Columns(Col_Prix), 1)
Pourrais-tu m'aider svp
Merci beaucoup
re,
le nombre de données à ce moment, cela dépasse 65.000 ?
Bonjour,
Je n'ai pas compté mais oui c'est probable et à terme cela sera le cas
Merci
re,
maintenant sans ce aggregate, je copie et colle les prix filtrés vers la colonne BA de la feuille "Données" et je prends le maximum. Vous pouvez changer cette colonne au début de la macro, si elle ne vous convient pas
Sub Recup_Donnees_BSALV()
Dim aA, cOut, aOut, c As Range, MyMax, cPrix
t = Timer
Set sh = Sheets("Donnees") 'cette feuille
If sh.AutoFilterMode Then sh.AutoFilterMode = False
Set cPrix = sh.Columns("BA") '-----> la colonne, on utilisera pour le prix max, vous pouvez choisir une autre colonne
aA = sh.Range("A1").CurrentRegion.Value2 'matrice avec les données
Set cOut = sh.Range("A1").CurrentRegion.Columns(24) 'plage où les nouveaux prix seront inscrit
ReDim aOut(1 To UBound(aA), 1 To 1) 'valeurs actuelles des prix
aOut(1, 1) = aA(1, 24)
For i = 2 To UBound(aA) 'boucles les lignes de "Données"
If InStr(1, s, "|" & aA(i, 18) & "|", 1) = 0 Then 'un nouveau fournisseur unique ?
s = s & "|" & aA(i, 18) & "|" 'string avec les noms uniques des feuilles
On Error Resume Next
Set c = Nothing: Set c = Sheets(CStr(aA(i, 18))).Range("A1").CurrentRegion.Resize(, 30) 'la plage des données d'un fournisseur
On Error GoTo 0
If c Is Nothing Then
MsgBox "no feuille fournisseur " & aA(i, 18)
Else
c.AutoFilter 'RAZ autofilter
For Each el In Array("Référence", "Référence Tarif", "CODE ARTICLE", "N° CODE") 'matrice avec tous les noms possible de la colonne de référence des fournisseurs
Col_Ref = Application.Match(el, c.Rows(1), 0) 'cherche colonne de Référence
If IsNumeric(Col_Ref) Then Exit For
Next
For Each el In Array("Prix Tarif", "TARIF", "PRIX") 'matrice avec tous les noms possible de la colonne des prix des fournisseurs
Col_Prix = Application.Match(el, c.Rows(1), 0) 'cherche colonne des prix
If IsNumeric(Col_Prix) Then Exit For
Next
If Not IsNumeric(Col_Ref) Or Not IsNumeric(Col_Prix) Then
MsgBox "problème avec la colonne de référence ou du prix", vbCritical, "feuille " & aA(i, 18)
Else
For i1 = i To UBound(aA)
If aA(i1, 18) = aA(i, 18) Then 'même nouveau fournisseur
cPrix.ClearContents
c.AutoFilter Col_Ref, aA(i1, 19) 'autofilter avec votre référence
c.Columns(Col_Prix).Copy cPrix.Cells(1) 'copier les cellules visible de prix vers feuille données BA1
MyMax = Application.Max(cPrix.EntireColumn) 'le max des valeurs visibles non-erronnés
If IsNumeric(MyMax) Then aOut(i1, 1) = MyMax Else aOut(i1, 1) = "???" '
End If
Next
c.AutoFilter
End If
End If
End If
Next
cOut.Value = aOut 'écrire le résultat dans la bonne colonne
MsgBox "prêt en " & Format(Timer - t, "0.00\s") & vbLf & Format(UBound(aA), "#,###") & " lignes"
End SubBonjour,
Merci pour votre aide.
Je suis en train de tester avec les différents fichiers et cela prend du temps.
Petite question, est-ce qu'il est possible de créer une colonne et d'y mettre les nouveaux prix lors des mises à jours (au lieu de mettre les prix dans une colonne existante) ?
L'idée ensuite serait de contrôler l'évolution de prix et de voir aussi si je me suis pas planté
Merci
bonjour,
l'idée est de mettre tous les données des feuilles dans un tableau de la feuille "TCD" et puis de créer un TCD avec le prix max des articles. Comme ca, vous pouvez voir l'évolution.
Mais je n'au aucune idée combien de lignes representent une journée dans votre cas ? En combien de jours vous avez une feuille complete, cad +1.048.000 lignes ?
Pour le moment, ce n'est pas encore complet et uniquement dans la feuille "TCD"
Bonjour,
Je ne sais pas en combien de temps le fichier atteindra 1048000 lignes.
Plusieurs petites questions:
- si je veux mettre à jour à 1 moment donné 1 seul fournisseur ( si par exemple seul 1 fournisseur change de tarif, un jour X) , est-ce qu'il y a un code plus rapide?
Lorsque que je modifie le code VBA pour 1 seul fournisseur, la mise à jours indique fort justement, qu'il y a plusieurs fournisseurs qui ne peut pas mettre à jour.
Sachant que pour le moment, il y a des références qui ne se font plus par les fournisseurs qui restent dans le fichier données et que je ne peux pas enlevées. (ceci pour comparer les prix)
- si je veux mettre à jours les conditionnements et non les prix, avez-vous un code ?
J'avais pour idée de mettre un bouton qui fait une mise à jour générale prix et un autre conditionnement et un bouton rattaché à une macro qui fait une mise à jour prix par fournisseur et un autre pour les conditionnements.
Encore une fois un grand merci à vous