Autres Tableaux virtuels très lents..

Calvus · 8 Mars 2020

Bonjour le forum,

J'ai l'habitude de manipuler des tableaux en VBA, notamment pour le gain en vitesse et la maniabilité, mais je suis confronté à une nouveauté !

La macro présente dans le fichier fonctionne très bien mais est d'une extrême lenteur. Près de 100 secondes, et même un peu plus dans mon fichier original qui va chercher les données dans un autre classeur. (J'ai ajouté une feuille dans le classeur exemple pour plus de simplicité, donc sans ouverture d'autre classeur)

Habituellement le temps de traitement n'excède pas quelques secondes.

J'ai eu beau chercher, je ne vois pas. L'écriture du code me semble correcte et ne diffère pas de ce que j'ai l'habitude de faire.
Un œil neuf verra peut être quelque chose qui m'a échappé.

Fonctionnement de la macro :
Elle va chercher et classer les achats de chaque fournisseur par année, pour chaque client.
Création de 2 dictionnaires, réalisation d'un tableau, et ensuite traitement du tableau pour le résultat final.
C'est là le point qui pose problème et ralentit le code. J'ai mis un commentaire visible sur le code.

Enfin écriture du tableau final sur la feuille : Fourn Par Client
Le bouton Calcul permet le lancement de la macro.
Les 2 autres feuille contiennent les données.

Le Checkbox "Avec Montant" permet de désactiver une partie du code, à savoir ne pas traiter les données par année, et là le code s'exécute en 1,32 secondes seulement.

Merci de votre aide et bon dimanche.

patricktoulon · 9 Mars 2020

je pige pas vraiment le besoins de comparer les fournisseurs d'une feuille a l'autre pour ne prendre que ceux qui existe dans l'une en fonction de l'année et d'une case vide MAIS BON .......
voila comment je remplace ceci

VB:

'Dico pour les clients
For i = 1 To UBound(tMvtStock)
    For j = 1 To UBound(tClients)

    If tMvtStock(i, 6) = tClients(j, 1) And tClients(j, 15) = "" _
    And Year(tMvtStock(i, 1)) >= Annee Then
        dcli(tMvtStock(i, 6)) = tMvtStock(i, 6)
    End If
    Next j
Next i
ReDim a(1 To UBound(tMvtStock), 1 To 6)
n = 1
For Each c In dcli.keys
'Debug.Print d.Count
'Debug.Print d(c)
    a(n, 1) = c
    n = n + 1
Next c

par cela

VB:

'Dico  + tableau pour les clients en un seul coup
    Dim Ok As Boolean, Ax&
    For i = 1 To UBound(tMvtStock)
        For j = 1 To UBound(tClients)
            Ok = tMvtStock(i, 6) = tClients(j, 1) And tClients(j, 15) = "" And Year(tMvtStock(i, 1)) >= Annee
            If Ok And Not dcli.exists(tMvtStock(i, 6)) Then
                dcli(tMvtStock(i, 6)) = tMvtStock(i, 6)
                Ax = Ax + 1: ReDim Preserve a(1 To 6, 1 To Ax): a(1, Ax) = tMvtStock(i, 6)
            End If
        Next j
    Next i
    a = Application.Transpose(a)

donc si je te suis je ferais comme ça déjà pour commencer
regarde le message 😉

VB:

Option Explicit

Sub F_Par_Client2()
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With

    Dim fFourn As Worksheet, fClients As Worksheet, tClients
    Dim tabfin, i%, Annee As String

    Dim start As Single
    start = Timer

    Set fFourn = Sheets("Fourn Par Client")
    Set fClients = Sheets("Clients")
    Set tabfin = fFourn.ListObjects("Tableau16")
    tClients = fClients.Range("B3:P" & fClients.Range("B" & Rows.Count).End(xlUp).Row)
    Annee = fFourn.Range("B2")

    'Effacement du 1er tableau
    Set tabfin = fFourn.ListObjects("Tableau16")
    tabfin.DataBodyRange.Delete


    Dim fMvtStock As Worksheet, fVentes As Worksheet, tMvtStock, tCommandes, a(), b()
    Dim j%, n%, m%, k%

    Set fMvtStock = Sheets("Mvts Stock")

    tMvtStock = fMvtStock.Range("B3:V" & fMvtStock.Range("B" & Rows.Count).End(xlUp).Row)

    'MsgBox "Durée du traitement: " & Timer - start & " secondes"

    Dim dcli, dfourn
    Set dcli = CreateObject("Scripting.Dictionary")
    Set dfourn = CreateObject("Scripting.Dictionary")
    dcli.CompareMode = vbTextCompare
    dfourn.CompareMode = vbTextCompare

    'Dico  + tableau pour les clients en un seul coup
    Dim Ok As Boolean, Ax&
    For i = 1 To UBound(tMvtStock)
        For j = 1 To UBound(tClients)
            Ok = tMvtStock(i, 6) = tClients(j, 1) And tClients(j, 15) = "" And Year(tMvtStock(i, 1)) >= Annee
            If Ok And Not dcli.exists(tMvtStock(i, 6)) Then
                dcli(tMvtStock(i, 6)) = tMvtStock(i, 6)
                Ax = Ax + 1: ReDim Preserve a(1 To 6, 1 To Ax): a(1, Ax) = tMvtStock(i, 6)
            End If
        Next j
    Next i
    a = Application.Transpose(a)
    ' et on continu (faire pareil pour dfourn et le tableau b )
    '...
    '...

    MsgBox "dcli.count= " & dcli.Count & vbCrLf & "le ubound(a) = " & UBound(a)


    With Application: .ScreenUpdating = True: .Calculation = xlAutomatic: .EnableEvents = True: End With

End Sub

😉

Staple1600 · 9 Mars 2020

Bonsoir le fil

[rebondance 1 - synergie 0]

Dans le post 11 Staple1600 à dit:

Re

Merci
Pourquoi cette boucle?

VB:

'Effacement du 1er tableau
For i = Range("B" & Rows.Count).End(xlUp).Row - 4 To 1 Step -1
    With tabfin
        .ListRows(i).Range.Delete
    End With
Next i^

Une ligne suffit 😉

VB:

Sub testA()
'supprime le contenu
ActiveSheet.ListObjects("loTest").DataBodyRange.Rows.ClearContents
End Sub

ou

VB:

Sub testB()
'supprime les lignes sauf la première et la ligne d'entete
ActiveSheet.ListObjects("loTest").DataBodyRange.Delete
End Sub

Dans le post 29 patricktoulon à dit:
la boucle est basé sur quel sheets ? on sait pas
n'y a til pas moyen de deleter le tabfin en un seul coup cherche bien 😉
un truc du genre par exemple
tabfin .DataBodyRange.Delete

et plein plein de petite chose comme ça qui te ferait gagner du temps

[rebondance 1 - synergie 0]
🙄

eriiic · 9 Mars 2020

Bonjour à tous,

VB:

                If tFinal(i, 1) = tMvtStock(j, 6) And tFinal(i, 11) = tMvtStock(j, 5) _
                    And Year(tMvtStock(j, 1)) = an1 Then

En vba, malheureusement, dans un If tous les tests sont évalués même si on est exclu dès le premier.
Dans une grande boucle il vaut mieux les écrire sur plusieurs lignes comme ça :

Code:

If tFinal(i, 1) = tMvtStock(j, 6) Then
  if tFinal(i, 11) = tMvtStock(j, 5) then
    if Year(tMvtStock(j, 1)) = an1 Then

Et pour bien optimiser il faut tester en premier celui qui à le plus de chance d'être négatif, et ainsi de suite, pour sortir statistiquement plus tôt.
Si un test a 80% de chance d'être négatif autant le tester en 1er pour éviter les autres inutiles.
De plus tu répètes 6 fois If tFinal(i, 1) = tMvtStock(j, 6) And tFinal(i, 11) = tMvtStock(j, 5) commun aux 6 if si je ne m'abuse. Chaque test inutile coûte cher.

En ré-écrivant ainsi je passe de 152 s à 9.6 s :

Code:

                If tFinal(i, 1) = tMvtStock(j, 6) Then
                    If tFinal(i, 11) = tMvtStock(j, 5) Then
                        If Year(tMvtStock(j, 1)) = an1 Then
                            somme = somme + Round(tMvtStock(j, 21), 2)
                        End If
                        If Year(tMvtStock(j, 1)) = an2 Then
                            somme2 = somme2 + Round(tMvtStock(j, 21), 2)
                        End If
                        If Year(tMvtStock(j, 1)) = an3 Then
                            somme3 = somme3 + Round(tMvtStock(j, 21), 2)
                        End If
                        If Year(tMvtStock(j, 1)) = an4 Then
                            somme4 = somme4 + Round(tMvtStock(j, 21), 2)
                        End If
                        If Year(tMvtStock(j, 1)) = an5 Then
                            somme5 = somme5 + Round(tMvtStock(j, 21), 2)
                        End If
                    End If
                End If

Eventuellement même punition pour tes dicos bien que là le gain sera moindre, les boucles sont plus petites à-priori.
eric

Calvus · 10 Mars 2020

Bonsoir à tous,

patricktoulon à dit:
je pige pas vraiment le besoins de comparer les fournisseurs d'une feuille a l'autre pour ne prendre que ceux qui existe dans l'une en fonction de l'année et d'une case vide MAIS BON .......

Parce qu'ils n'ont plus tous une utilité.

Pour le reste, il faut que je revoie demain car pour l'instant je n'arrive à rien avec ton code. Il faut que j'en étudie les subtilités qui m'échappent.

@eriiiic

Merci de tes explications.
C'est en effet très rapide, mais un poil moins que le code de sylvanu.
Je saurai néanmoins mieux écrire mes If à l'avenir. Je pensais que mon écriture était plus rapide, je me trompais ! Ravi d'avoir appris quelque chose sur la structure du code.

Merci !

Autres Tableaux virtuels très lents..

Calvus

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

eriiic

XLDnaute Barbatruc

Calvus

XLDnaute Barbatruc

Discussions similaires

Autres Tableaux virtuels très lents..

Calvus

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

eriiic

XLDnaute Barbatruc

Calvus

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency