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 : Sélectionner tout - Visualiser dans une fenêtre à part
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 !!!