XL 2019 Augmenter la vitesse de traitement

Titof06 · Mardi à 14:03

Bonjour,

Je vous présente tous mes voeux pour 2026, surtout de Santé.

Je reviens vers vous pour demander si vous auriez une solution pour mon traitement.

Je dois mettre à jour des prix d'articles de fournisseurs.
Vous trouverez un onglet "TARFIS Fournisseur" qui correspond aux nouveaux tarifs.
Vous aurez également un onglet "Source" où se trouve mes informations relatives aux mises à jour.
Vous verrez que je ne mettrai à jour que les lignes dont la colonne "D" n'est pas en "KO" et celles qui seront en "Dif.".

Dans mon exemple, il n'y en a qu'une et le nombre de lignes a été limité.
Mais si je prends les données réelles, j'ai 15 000 lignes dans le "Source" et plus de 150 000 Lignes dans "TARFIS Fournisseur".

J'ai utilisé les fonctions suivantes :

For l = 2 to 15 000 (lignes du "Source")
une condition avec la fonction "Find." pour mettre à jour le nouveau prix
Next l

For Each donn In maplage (Zone de recherche dans les 150 000 lignes)
une condition avec la fonction "Find." pour mettre à jour le nouveau prix
Next donn

Ces 2 type de traitements sont extrêmement longs.

Dans mon exemple joint, j'utilise une "RECHERCHEV" pour définir les articles à mettre à jour, mais en réalité j'utilise la fonction "Find.".

Auriez-vous une solution pour que cela se fasse plus vite, svp ?

Je vous souahite une agréable journée,

Titof06

Dranreb · Mercredi à 11:47

Il y avait quelques erreurs de noms d'objets Worksheet Feuil5 qui représente la "TARIFS_Fournisseurs" au lieu de Feuil3
Et "KO" qui était répété 3 fois sur la colonne C au lieu des C, D et E.

Dranreb · Mardi à 15:50

Bonjour.
La règle générale pour gagner beaucoup de temps d'exécution, c'est de passer par des tableaux VBA dynamiques.
J'ouvre à présent votre classeur …

Je n'y ai pas trouvé de code de la forme que vous indiquez.

Titof06 · Mardi à 16:28

Dranreb à dit:
Bonjour.
La règle générale pour gagner beaucoup de temps d'exécution, c'est de passer par des tableaux VBA dynamiques.
J'ouvre à présent votre classeur …

Je n'y ai pas trouvé de code de la forme que vous indiquez.

Bonjour Dranreb,

Tout d'abord, Je vous souhaite une belle année 2026, et surtout la santé.

Oui, je n'ai pas mis le code car, en fait, il est rattaché à plusieurs onglets et cela est vraiment très gros (en poids) plus de 100 centaines de Mo.

Qu'appelez-vous des tableaux VBA dynamiques, svp ?

Pour vous expliquez, je scanne ligne à ligne chaque article de l'onglet "Source" et je vérifie s'il existe, et dans le cas où celui-ci existe, je mets à jour son prix dans une autre colonne.
C'est pour cela qu'actuellement j'utilise la fonction "For Each.... et Next" pour scanner la zone définie dans ma plage.
Et pour un fichier avec le nombre de lignes évoquées, cela prend beaucoup de temps.

Je voulais juste savoir si j'avais la possibilité de réduire ce temps, d'une façon ou une autre.

Je vous remercie pour le temps que vous m'accordez et vous souhaite une agréable fin de journée,

Titof06

Dranreb · Mardi à 16:44

En tout cas ce code dans le module de l'objet Worksheet représentant la feuille "Source" est très rapide :

VB:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim Dic As Scripting.Dictionary, TDon(), L&
   Set Dic = New Dictionary
   TDon = Feuil3.[A2:B2].Resize(Feuil5.Cells(2 ^ 20, "A").End(xlUp).Row - 1).Value
   For L = 1 To UBound(TDon, 1)
      Dic(TDon(L, 1)) = CCur(TDon(L, 2)): Next L
   TDon = Me.[A2:E2].Resize(Me.Cells(2 ^ 20, "A").End(xlUp).Row - 1).Value
   For L = 1 To UBound(TDon, 1)
      TDon(L, 2) = CCur(TDon(L, 2))
      If Dic.Exists(TDon(L, 1)) Then
         TDon(L, 3) = TDon(L, 1)
         TDon(L, 4) = Dic(TDon(L, 1))
         TDon(L, 5) = IIf(TDon(L, 4) <> TDon(L, 2), "Dif", Empty)
      Else
         TDon(L, 3) = "KO": TDon(L, 3) = "KO": TDon(L, 3) = "KO"
         End If
      Next L
   Me.[A2].Resize(UBound(TDon, 1), 5).Value = TDon
   End Sub

Important: Cocher la référence Microsoft Scripting Runtime.

Titof06 · Mardi à 16:49

Dranreb à dit:

En tout cas ce code dans le module de l'objet Worksheet représentant la feuille "Source" est très rapide :

VB:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim Dic As Scripting.Dictionary, TDon(), L&, PAB As Currency
   Set Dic = New Dictionary
   TDon = Feuil5.[A2:B2].Resize(Feuil5.Cells(2 ^ 20, "A").End(xlUp).Row - 1).Value
   For L = 1 To UBound(TDon, 1)
      Dic(TDon(L, 1)) = CCur(TDon(L, 2)): Next L
   TDon = Me.[A2:E2].Resize(Me.Cells(2 ^ 20, "A").End(xlUp).Row - 1).Value
   For L = 1 To UBound(TDon, 1)
      If VarType(TDon(L, 2)) = vbString Then TDon(L, 2) = CCur(TDon(L, 2))
      If Dic.Exists(TDon(L, 1)) Then
         TDon(L, 3) = TDon(L, 1)
         TDon(L, 4) = Dic(TDon(L, 1))
         TDon(L, 5) = IIf(TDon(L, 4) <> TDon(L, 2), "Dif", Empty)
      Else
         TDon(L, 3) = "KO": TDon(L, 3) = "KO": TDon(L, 3) = "KO"
         End If
      Next L
   Me.[A2].Resize(UBound(TDon, 1), 5).Value = TDon
   End Sub

Important: Cocher la référence Microsoft Scripting Runtime.

Bonjour Dranreb,

Je vous remercie pour cette proposition que j'essaierai demain matin.

Je vous tiendrai au courant.

Je vous remercie pour le temps que vous m'accordez et vous souhaite une agréable fin de journée,

Titof06

dysorthographie · Mardi à 18:16

Bonjour,

VB:

Sub test()
Sheets("TARIFS_Fournisseur").Range("A:A").NumberFormat = "@": Sheets("Source").Range("A:A").NumberFormat = "@"
ConvertirNum Sheets("TARIFS_Fournisseur").Range("B:B"): ConvertirNum Sheets("Source").Range("B:B")

Dim Cn, Sql As String: Cn = GenereCSTRING(Xls, Base:=ThisWorkbook.FullName, Titre:=True)
Sql = "UPDATE [TARIFS_Fournisseur$] T, [Source$] S SET T.[TARIF FOURNISSEUR] = S.[Prix Achat Brut] WHERE T.[REFCIALE FOURNISSEUR] = S.[Ref, Fournisseur]"
ExecuteRequete Sql, Cn
End Sub

Titof06 · Mercredi à 11:11

Titof06 à dit:
Bonjour Dranreb,

Je vous remercie pour cette proposition que j'essaierai demain matin.

Je vous tiendrai au courant.

Je vous remercie pour le temps que vous m'accordez et vous souhaite une agréable fin de journée,

Titof06

Bonjour Dranreb,

Je viens d'essayer votre solution , mais je n'arrive pas à la faire fonctionner.

J'ai essayé en sélectionnant des articles en Colonne A, en vain.

Pourriez-vous me dire comment, svp ?

Je vous remercie pour le temps que vous m'accordez et vous souhaite une agréable journée,

Titof06

Dranreb · Mercredi à 11:14

Bonjour.
Avez vous bien implanté le code dans le module de l'objet Worksheet représentant la feuille concernée ? Dans un module standard il sera sans effet.

Titof06 · Mercredi à 11:35

dysorthographie à dit:

Bonjour,

VB:

Sub test()
Sheets("TARIFS_Fournisseur").Range("A:A").NumberFormat = "@": Sheets("Source").Range("A:A").NumberFormat = "@"
ConvertirNum Sheets("TARIFS_Fournisseur").Range("B:B"): ConvertirNum Sheets("Source").Range("B:B")

Dim Cn, Sql As String: Cn = GenereCSTRING(Xls, Base:=ThisWorkbook.FullName, Titre:=True)
Sql = "UPDATE [TARIFS_Fournisseur$] T, [Source$] S SET T.[TARIF FOURNISSEUR] = S.[Prix Achat Brut] WHERE T.[REFCIALE FOURNISSEUR] = S.[Ref, Fournisseur]"
ExecuteRequete Sql, Cn
End Sub

Bonjour Dysorthographie,

Je vous remercie pour votre solution, mais cela doit sans doute très bien fonctionner, excepté que je ne vois pas le résultat.

Je vous remercie pour le temps que vous m'accordez et vous souhaite une agréable journée,

Titof06

Titof06 à dit:
Bonjour Dranreb,

Je viens d'essayer votre solution , mais je n'arrive pas à la faire fonctionner.

J'ai essayé en sélectionnant des articles en Colonne A, en vain.

Pourriez-vous me dire comment, svp ?

Je vous remercie pour le temps que vous m'accordez et vous souhaite une agréable journée,

Titof06

Dranreb à dit:
Bonjour.
Avez vous bien implanté le code dans le module de l'objet Worksheet représentant la feuille concernée ? Dans un module standard il sera sans effet.

Bonjour Dranreb,

Oui, pardon, je viens d'essayer votre solution en mettant le code dans la feuille correspondante et cela fonctionne.

Il y a un mais, car on dirait que c'est un copier-coller des colonnes A & B.

Je prends comme exemple l'onglet "Source Original", en ligne 56 je dois trouver 80,00€ au lieu des 123,94 €.

Je souhaitais également ne mettre qu'à jour, que les articles qui ne sont pas en "KO" en colonne C.

Je ne tiens pas compte des articles en "KO" car ils sont sans doute plus vendus ou en stocks.

Je vous remercie pour le temps que vous m'accordez et vous souhaite une agréable journée,

Titof06

Dranreb · Mercredi à 11:47

Il y avait quelques erreurs de noms d'objets Worksheet Feuil5 qui représente la "TARIFS_Fournisseurs" au lieu de Feuil3
Et "KO" qui était répété 3 fois sur la colonne C au lieu des C, D et E.

dysorthographie · Mercredi à 11:53

Titof06 à dit:
Je vous remercie pour votre solution, mais cela doit sans doute très bien fonctionner, excepté que je ne vois pas le résultat.

bonjour,
les TARIF FOURNISSEUR on été mis à jour en fonction des Prix Achat Brut
. pour les réf fournisseurs identique.

Titof06 à dit:
Je dois mettre à jour des prix d'articles de fournisseurs.
Vous trouverez un onglet "TARFIS Fournisseur" qui correspond aux nouveaux tarifs.

peut-être devrais tu regardé si le prix de onglet "TARFIS Fournisseur" associé au ref. fournisseurs on correctement été mis a jour!
si tu veux je peux rajouter les réf. fournisseurs qui n'existe pas ?

VB:

Sub test()
    ' Formate les colonnes A en texte pour éviter la conversion automatique des nombres
    Sheets("TARIFS_Fournisseur").Range("A:A").NumberFormat = "@": Sheets("Source").Range("A:A").NumberFormat = "@"
    
    ' Convertit les colonnes B (prix) en format numérique avec le bon séparateur décimal
    ConvertirNum Sheets("TARIFS_Fournisseur").Range("B:B"): ConvertirNum Sheets("Source").Range("B:B")

    ' Génère la chaîne de connexion pour accéder au classeur Excel comme une base de données
    Dim Cn, Sql As String: Cn = GenereCSTRING(Xls, Base:=ThisWorkbook.FullName, Titre:=True)
    
    ' Mise à jour des tarifs existants : remplace les prix de TARIFS_Fournisseur 
    ' par ceux de Source quand les références correspondent
    Sql = "UPDATE [TARIFS_Fournisseur$] T, [Source$] S SET T.[TARIF FOURNISSEUR] = S.[Prix Achat Brut] WHERE T.[REFCIALE FOURNISSEUR] = S.[Ref, Fournisseur]"
    ExecuteRequete Sql, Cn
    
    ' Insertion des nouvelles références : ajoute dans TARIFS_Fournisseur 
    ' toutes les références présentes dans Source mais absentes de TARIFS_Fournisseur
    Sql = "INSERT INTO [TARIFS_Fournisseur$] ([REFCIALE FOURNISSEUR], [TARIF FOURNISSEUR])" & _
            "SELECT [Ref, Fournisseur], [Prix Achat Brut] FROM [Source$] WHERE [Ref, Fournisseur] NOT IN " & _
            "(SELECT [REFCIALE FOURNISSEUR] FROM [TARIFS_Fournisseur$])"
    ExecuteRequete Sql, Cn
End Sub

Titof06 · Mercredi à 13:43

Dranreb à dit:
Il y avait quelques erreurs de noms d'objets Worksheet Feuil5 qui représente la "TARIFS_Fournisseurs" au lieu de Feuil3
Et "KO" qui était répété 3 fois sur la colonne C au lieu des C, D et E.

Bonjour Dranreb,

Je viens d'essayer votre solution et cela fonctionne parfaitement.

Je vous remercie pour le temps que vous m'accordez et vous souhaite une agréable fin de journée,

Titof06

Titof06 · Mercredi à 13:50

dysorthographie à dit:

bonjour,
les TARIF FOURNISSEUR on été mis à jour en fonction des Prix Achat Brut
. pour les réf fournisseurs identique.

peut-être devrais tu regardé si le prix de onglet "TARFIS Fournisseur" associé au ref. fournisseurs on correctement été mis a jour!
si tu veux je peux rajouter les réf. fournisseurs qui n'existe pas ?

VB:

Sub test()
    ' Formate les colonnes A en texte pour éviter la conversion automatique des nombres
    Sheets("TARIFS_Fournisseur").Range("A:A").NumberFormat = "@": Sheets("Source").Range("A:A").NumberFormat = "@"
   
    ' Convertit les colonnes B (prix) en format numérique avec le bon séparateur décimal
    ConvertirNum Sheets("TARIFS_Fournisseur").Range("B:B"): ConvertirNum Sheets("Source").Range("B:B")

    ' Génère la chaîne de connexion pour accéder au classeur Excel comme une base de données
    Dim Cn, Sql As String: Cn = GenereCSTRING(Xls, Base:=ThisWorkbook.FullName, Titre:=True)
   
    ' Mise à jour des tarifs existants : remplace les prix de TARIFS_Fournisseur
    ' par ceux de Source quand les références correspondent
    Sql = "UPDATE [TARIFS_Fournisseur$] T, [Source$] S SET T.[TARIF FOURNISSEUR] = S.[Prix Achat Brut] WHERE T.[REFCIALE FOURNISSEUR] = S.[Ref, Fournisseur]"
    ExecuteRequete Sql, Cn
   
    ' Insertion des nouvelles références : ajoute dans TARIFS_Fournisseur
    ' toutes les références présentes dans Source mais absentes de TARIFS_Fournisseur
    Sql = "INSERT INTO [TARIFS_Fournisseur$] ([REFCIALE FOURNISSEUR], [TARIF FOURNISSEUR])" & _
            "SELECT [Ref, Fournisseur], [Prix Achat Brut] FROM [Source$] WHERE [Ref, Fournisseur] NOT IN " & _
            "(SELECT [REFCIALE FOURNISSEUR] FROM [TARIFS_Fournisseur$])"
    ExecuteRequete Sql, Cn
End Sub

Bonjour Dysorthographie,

Non, je te remercie, ta proposition fonctionne également très bien.
En fait, on travaille à l'envers, si la référence fournisseur existe, on la met à jour, sinon, on ne fait rien... c'est le patron qui décide !
Il ne souhaite pas incorporer tous les articles inexistants, afin d'éviter de surcharger la base.
Notre ERP n'est pas très jeune, et on ne sait pas combien d'articles il pourrait supporter.
Donc, on garde les articles qui ont du stock ou ceux qui ont été mouvementés dans l'année en cours et la précédente.

Il va falloir que je regarde comment l'adapter pour d'autres mises à jour.

Le language SQL est un peu vieux, j'en avais fait il y a une dizaine d'années, je vais m'y remettre.
On dit que c'est comme le vélo, que cela ne s'oublie pas...mais quand même les années font oublier la pratique.

Je te remercie pour le temps que tu m'accordes et te souhaite une agréable fin de journée,

Titof06

Titof06 · Hier à 14:47

Bonjour Dranred,

J'ai essayé d'adapter votre solution à mes fichiers, mais je n'y arrive pas.

Je vous joins un fichier où un onglet "Cahier Des Charges" vous indique ce que je dois exactement faire.

Si vous avez un peu de temps pour me l'adapter, svp, j'essairai par la suite de comprendre votre démarche pour arriver à cela.

Voici le lien WeTransfert, cale fichier fait plus de 10 Mo : https://we.tl/t-cQPhYfEVOp

Je vous remercie pour le temps que vous m'accordez et vous souhaite une agréable fin de journée,

Titof06

Dranreb · Hier à 16:54

Non, tâchez de comprendre comment ça fonctionne dans l'autre classeur pour pouvoir l'appliquer ailleurs.

XL 2019 Augmenter la vitesse de traitement

Titof06

XLDnaute Occasionnel

Pièces jointes

Dranreb

Dranreb

XLDnaute Barbatruc

Titof06

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

Titof06

XLDnaute Occasionnel

dysorthographie

XLDnaute Barbatruc

Pièces jointes

Titof06

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

Pièces jointes

Titof06

XLDnaute Occasionnel

Pièces jointes

Dranreb

XLDnaute Barbatruc

Pièces jointes

dysorthographie

XLDnaute Barbatruc

Titof06

XLDnaute Occasionnel

Titof06

XLDnaute Occasionnel

Titof06

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

Discussions similaires

XL 2019 Augmenter la vitesse de traitement

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency