Excel VBA Optimisation/Temps d'execution

Version imprimable

Salut !
Première fois que je poste sur ce magnifique forum où j'ai appris tout ce que je connais en vba !
Alors voilà pour vous les experts qui donnent de leur temps pour résoudre nos problemes :)

J'ai fait un petit programme qui fait le tracking de changements d'une base j versus j-1.
J'ai un temps d'execution qui tourne autours des 7 minutes et je souhaiterai le réduire autant que possible.
Je passes déjà par des tableaux de type variant et ai desactivé le screen-updating et l'auto calculation.
Chaque base fait environ 50 000 lignes sur 4 colonnes, voici la procédure:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
 
Option Base 1
Sub FillBuffer()
 
Dim M As Long, dlig1 As Long, dlig2 As Long
dlig1 = Temp1.Range("A1048576").End(xlUp).Row
dlig2 = Temp2.Range("A1048576").End(xlUp).Row
ReDim buffer(1 To 6, 1 To 1)
t1 = Temp1.Range("A1:D" & dlig1).Value
t2 = Temp2.Range("A1:D" & dlig2).Value
 
buf.Activate
buf.Range(Columns(1), Columns(100)).ClearContents
 
'---------------------------------------
'Loop to categorize the change type
For i = LBound(t1, 1) To UBound(t1, 1)
    M = 0
    For j = LBound(t2, 1) To UBound(t2, 1)
        If t1(i, Col_DIM) = t2(j, Col_DIM) Then
        If t1(i, Col_SON) = t2(j, Col_SON) Then
        If t1(i, Col_SOI) = t2(j, Col_SOI) Then
            If t1(i, Col_VAL) <> t2(j, Col_VAL) Then
                M = t1(i, Col_DIM)
                GoTo Seen
            Else: GoTo NewSeen
            End If
        End If
        End If
        End If
    Next j
'---------------------------------------
 
'---------------------------------------
'Fill Buffer based on previous evaluation
Seen:
 
    Select Case M
        Case Is = 0
            buffer(Col_ADB_NCT, UBound(buffer, 2)) = "Order Line Creation"
            buffer(Col_ADB_NOV, UBound(buffer, 2)) = "Nothing"
            buffer(Col_ADB_NNV, UBound(buffer, 2)) = "Full Line Created"
            buffer(Col_ADB_NPO, UBound(buffer, 2)) = t1(i, Col_SON)
            buffer(Col_ADB_NSO, UBound(buffer, 2)) = t1(i, Col_SOI)
            buffer(Col_ADB_NSD, UBound(buffer, 2)) = SnapDate
            ReDim Preserve buffer(1 To 6, 1 To UBound(buffer, 2) + 1)
            GoTo NewSeen
        Case Is = 1
            buffer(Col_ADB_NCT, UBound(buffer, 2)) = "Order Qty Change"
        Case Is = 2
            buffer(Col_ADB_NCT, UBound(buffer, 2)) = "Order Requested Date Change"
        Case Is = 3
            buffer(Col_ADB_NCT, UBound(buffer, 2)) = "Order Commited Date Change"
        Case Is = 4
            buffer(Col_ADB_NCT, UBound(buffer, 2)) = "Order Batch Change"
        Case Is = 5
            buffer(Col_ADB_NCT, UBound(buffer, 2)) = "Order Shipping Number Change"
        Case Is = 6
            buffer(Col_ADB_NCT, UBound(buffer, 2)) = "Order Billing Document Change"
    End Select
 
    buffer(Col_ADB_NOV, UBound(buffer, 2)) = t2(j, Col_VAL)
    buffer(Col_ADB_NNV, UBound(buffer, 2)) = t1(i, Col_VAL)
    buffer(Col_ADB_NPO, UBound(buffer, 2)) = t1(i, Col_SON)
    buffer(Col_ADB_NSO, UBound(buffer, 2)) = t1(i, Col_SOI)
    buffer(Col_ADB_NSD, UBound(buffer, 2)) = SnapDate
    ReDim Preserve buffer(1 To 6, 1 To UBound(buffer, 2) + 1)
'---------------------------------------
NewSeen:
Next i
 
buf.Activate
buf.Range("A1:F" & UBound(buffer, 2)) = Application.Transpose(buffer)
 
End Sub

J'ai plus trop d'idées pour l'optimisation, mais peut-être connaissez vous des moyens/techniques pour accélérer les boucles , en sortir au bon moment ou encore contourner l'utilisation des redim preserve :)
Dans l'attente de vous relire !!!

21/02/2020, 15h18
Menhir

En gros, tes boucles font plus de 2 milliard de tours. Pas étonnant que prennent un peu de temps.
Surtout avec un langage comme VBA qui est un pauvre interpréteur loin d'être optimisé pour la vitesse.

Si tu veux avoir un meilleur temps de traitement, il va falloir passer sur un langage compilé comme un membre de la famille C.

Bonjour,

Essaie cet exemple :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub EssaiReDimPreserve()
Dim i As Long, t As Single, v() As Variant, u() As Variant, count As Long
    t = Timer
    For i = 1 To 500000
        ReDim Preserve v(i)
        v(i) = i
    Next i
    MsgBox "Redim en boucle : " & Timer - t
    t = Timer
    ReDim  u(10000000)
    For i = 1 To 500000
        u(i) = i
        count = count + 1
    Next i
    ReDim Preserve u(count)
    MsgBox "Redim 1 fois : " & Timer - t
End Sub

21/02/2020, 15h29
révèr
Bonjour Menhir et lafteure,

Tracking de changements de base ? Tu veux faire quoi des données J vers J-1 concrètement ?
Citation:
Envoyé par Lafteure

Salut !

Chaque base fait environ 50 000 lignes sur 4 colonnes, voici la procédure

...

Code:

1 2 3 dlig1 = Temp1.Range("A1048576").End(xlUp).Row dlig2 = Temp2.Range("A1048576").End(xlUp).Row
Tu parcours quand un certain nombre de lignes inutilement ne trouves-tu pas ?

Ctrl + * sur ton tableau -> Mettre sous forme de tableau -> Renommer ("t_exemple")

Comment atteindre la dernière ligne alors ?

Plus besoin ! Tu n'auras qu'à faire un petit...
Code:

1 2 3 4 5 Dim Cible As Range For Each Cible In Workbooks(...).Worksheets(...).ListObjects("t_exemple").ListColumns(1).DataBodyRange 'Ton code Next Cible
21/02/2020, 16h01
Lafteure

Bonjour à vous trois et merci de votre réactivité.

Ok Menhir, je note ton idée mais la faut que je recommence depuis le départ car je ne connais pas du tout ces langages ^^

Pijaku et révèr, je ne vous ai pas donné bcp de détails sur ce que j’attends de mon code sorry ��
En fait j’ai une base access qui fait le stockage de lignes qui correspondent à des commandes clients et leurs attributs (qty, numéro de livraison, N° de facturation et pleins d’autres trucs).
Cette base est updatée chaque jour, et mon programme vise à relever les changement d’un jour à l’autre.
Donc en amont du code que je vous ai donné, j’extrait de l’information que je stock en 4 colonnes :
- Colonne 1 : clé de répartition 1
- Colonne 2 : clé de répartition 2
- Colonne 3 : valeur (la nature peut varier car pour un couple col1=X, col2=Y je peux avoir pleins d’informations différentes qui correspondent aux attributs de la commande (qty, N) de livraison, etc.))
- Colonne 4 : un numéro qui catégorise l’information stocké en col3

Ces 4 colonnes on les retrouve dans deux tables, une pour le jour J et une pour le jour J-1 (nommées t1 et t2)

Mon code doit comparer ces deux tables et remonter les changements de valeur en col3 pour un trio col1=X,col2=Y,col3=Z.
Ces changements sont renseignés dans un variant que j’ai appelé Buffer ou je fais un redim preserve à chaque fois qu’un changement est detecté.

Pour construire le code ce buffer je le colle dans une feuille excel mais a terme il sera renvoyé dans une base access.

Pijaku, tu me conseil de ne pas passer par un preserve mais de directement donner une taille « suffisante » à mon variant ?
Révèr, les dlig1&2 ne sont calculé qu’une fois c’est pour charger mes variant t1 & t2 en une fois avec un tx = range(xx).value

Merci à vous !
21/02/2020, 16h10
pijaku

Citation:

Pijaku, tu me conseil de ne pas passer par un preserve mais de directement donner une taille « suffisante » à mon variant ?

Oui c'est ça.
Tu le dimensionnes largement, même trop, pour ton traitement (attention aussi aux dépassements de mémoire, mais ça devrait aller).
21/02/2020, 16h55
Lafteure

Pijaku, j'ai testé et effectivement je gagne du temps (Presque 40 seconde :) )
Merci à vous trois !
22/02/2020, 08h49
jurassic pork

hello,
d'après ce que j'ai compris , la combinaison des colonnes 1 , 2 et 4 est unique ?
si c'est le cas en utilisant un dictionnaire qui a comme clé une combinaison de ces 3 colonnes tu devrais pouvoir réduire de façon importante le temps d'exécution.
Ami calmant, J.P