Code avec utilisation de variables tableaux

**eric4459** · 03/08/2016, 14h50

Bonjour à tous ceux qui ne sont pas encore ou ne sont plus en Wacances

Voilà, j'ai écrit une macro de façon "Classique" dans un premier temps afin de mettre à jour deux colonnes d'un fichier à partir d'un second fichier que je reçois tous les mois.
Pas de soucis, le code fonctionne, le voici

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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
Sub Update_Forecasted_Date()
Dim File_Path As String
Dim File_Path2 As String
Dim File_Name As String
Dim Fld As String
Dim WkA As Workbook
Dim WkB As Workbook
Dim Src As Worksheet
Dim Dest As Worksheet
Dim GblDt As Worksheet
Dim Dlv1 As Range
Dim Dlv2 As Range
Dim FldName As Range
Dim NbLine1 As Integer
Dim NbLine2 As Integer
Dim NbLine3 As Integer
Dim Table1() As String
Dim Table2() As String
Dim Table3() As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim t As Double
t = Timer
Set WkA = ThisWorkbook
Set GblDt = WkA.Sheets("Global_Data")
Set Dest = WkA.Sheets("Cost Report")
Set Dlv1 = Dest.Range("B10")
Set FldName = GblDt.Range("U1")
 
File_Path = "C:\mon chemin\"
Fld = Dir(File_Path, vbDirectory)
 
With GblDt
    NbLine1 = .Cells(.Rows.Count, 21).End(xlUp).Row  ' Compte le nombre de ligne de la colonne U
End With
 
If NbLine1 <> "1" Then
GblDt.Range("U1:U" & NbLine1).ClearContents
End If
 
Do While Fld <> ""
    FldName.Offset(i, 0) = Fld
    Fld = Dir
    i = i + 1
Loop
 
With GblDt
    NbLine1 = .Cells(.Rows.Count, 21).End(xlUp).Row  ' Compte le nombre de ligne de la colonne U
End With
 
UserForm1.ComboBox1.List = GblDt.Range("U3:U" & NbLine1).Value
UserForm1.Show
 
File_Path2 = File_Path & UserForm1.ComboBox1.Value
File_Name = "Appendix C - Milestone Payment Schedule"
Workbooks.Open File_Path2 & "\" & File_Name
 
Set WkB = ActiveWorkbook
Set Src = WkB.Sheets("Cost Report")
Set Dlv2 = Src.Range("B10")
 
 
With Src
    NbLine2 = .Cells(.Rows.Count, 2).End(xlUp).Row  ' Compte le nombre de ligne de la colonne B de la feuille source
End With
 
With Dest
    NbLine3 = .Cells(.Rows.Count, 2).End(xlUp).Row  ' Compte le nombre de ligne de la colonne B de la feuille destination
End With
 
ReDim Table1(0 To NbLine2)
 
For j = 0 To UBound(Table1)
Table1(j) = Dlv2.Offset(j, 0)
Next j
 
For j = 0 To NbLine3
    For k = 0 To NbLine2
        If Dlv1.Offset(j, 0) = Dlv2.Offset(k, 0) And Dlv1.Offset(j, 6) = Dlv2.Offset(k, 6) Then
           Dlv1.Offset(j, 15) = Dlv2.Offset(k, 24)
           Dlv1.Offset(j, 15).NumberFormat = "[$-409]dd-mmm-yy;@"
           Dlv1.Offset(j, 16) = Dlv2.Offset(k, 25)
           Dlv1.Offset(j, 15).NumberFormat = "[$-409]dd-mmm-yy;@"
        End If
    Next k
Next j
 
 WkB.Close True
 
MsgBox "Treatment was performed in " & Application.Round((Timer - t), 1) & " Sec"
 
End Sub

Afin d'améliorer mes connaissances, d'optimiser le code et son temps de traitement (par curiosité car le premier code tourne en très peu de temps), j'ai utilisé des variables tableaux pour un résultat que je pensais identique, voici le code

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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
Sub Update_Forecasted_Date_Tab()
Dim File_Path As String
Dim File_Path2 As String
Dim File_Name As String
Dim Fld As String
Dim WkA As Workbook
Dim WkB As Workbook
Dim Src As Worksheet
Dim Dest As Worksheet
Dim GblDt As Worksheet
Dim Dlv1 As Range
Dim Dlv2 As Range
Dim FldName As Range
Dim NbLine1 As Integer
Dim NbLine2 As Integer
Dim NbLine3 As Integer
Dim Limit As Integer
Dim Table1() As String
Dim Table2() As String
Dim Table3() As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim t As Double
t = Timer
 
Set WkA = ThisWorkbook
Set GblDt = WkA.Sheets("Global_Data")
Set Dest = WkA.Sheets("Cost Report")
Set Dlv1 = Dest.Range("B10")
Set FldName = GblDt.Range("U1")
 
File_Path = "C:\mon chemin\"
Fld = Dir(File_Path, vbDirectory)
 
With GblDt
    NbLine1 = .Cells(.Rows.Count, 21).End(xlUp).Row  ' Compte le nombre de ligne de la colonne U
End With
 
If NbLine1 <> "1" Then
GblDt.Range("U1:U" & NbLine1).ClearContents
End If
 
Do While Fld <> ""
    FldName.Offset(i, 0) = Fld
    Fld = Dir
    i = i + 1
Loop
 
With GblDt
    NbLine1 = .Cells(.Rows.Count, 21).End(xlUp).Row  ' Compte le nombre de ligne de la colonne U
End With
 
UserForm1.ComboBox1.List = GblDt.Range("U3:U" & NbLine1).Value
UserForm1.Show
 
File_Path2 = File_Path & UserForm1.ComboBox1.Value
File_Name = "Appendix C - Milestone Payment Schedule"
Workbooks.Open File_Path2 & "\" & File_Name
 
Set WkB = ActiveWorkbook
Set Src = WkB.Sheets("Cost Report")
Set Dlv2 = Src.Range("B10")
 
With Src
    NbLine2 = .Cells(.Rows.Count, 2).End(xlUp).Row  ' Compte le nombre de ligne de la colonne B de la feuille source
End With
 
With Dest
    NbLine3 = .Cells(.Rows.Count, 2).End(xlUp).Row  ' Compte le nombre de ligne de la colonne B de la feuille destination
End With
 
If NbLine2 > NbLine3 Then 'Compare Nbline 2 & 3 to use the max value
Limit = NbLine2
ElseIf NbLine2 < NbLine3 Then
Limit = NbLine3
ElseIf NbLine2 = NbLine3 Then
Limit = NbLine2
End If
 
'***********************************Loading of Table1 Source Value: Table 2 Dimensions
 
ReDim Table1(0 To Limit, 3)
 
For j = 0 To UBound(Table1)
    Table1(j, 0) = Dlv2.Offset(j, 0)
    Table1(j, 1) = Dlv2.Offset(j, 6)
    Table1(j, 2) = Dlv2.Offset(j, 24)
    Table1(j, 3) = Dlv2.Offset(j, 25)
Next j
 
'***********************************Loading of Table2 Destination Value: Table 2 Dimensions
 
ReDim Table2(0 To Limit, 1)
 
For k = 0 To UBound(Table2)
    Table2(k, 0) = Dlv1.Offset(k, 0)
    Table2(k, 1) = Dlv1.Offset(k, 6)
Next k
 
For j = 0 To Limit
    For k = 0 To Limit
        If Table2(k, 0) = Table1(j, 0) And Table2(k, 1) = Table1(j, 1) Then
           Dlv1.Offset(k, 15) = Table1(j, 2)
           Dlv1.Offset(k, 15).NumberFormat = "[$-409]dd-mmm-yy;@"
           Dlv1.Offset(k, 16) = Table1(j, 3)
           Dlv1.Offset(k, 16).NumberFormat = "[$-409]dd-mmm-yy;@"
        End If
    Next k
Next j
 
MsgBox "Treatment was performed in " & Application.Round((Timer - t), 1) & " Sec"
 
 WkB.Close True
 
End Sub

Ce que je ne comprend pas, et vous allez peut-être pouvoir me l'expliquer, c'est que :

le code est plus lent (de quelques secondes)
le format que je cherche à appliquer n'est pas pris en compte (il l'est bien avec le premier code)

Quelle erreur / oubli ai-je pu commettre?
Merci pour aide et votre collaboration

Eric

**jurassic pork** · 03/08/2016, 23h21

hello,
arf ! difficile à tester car dépendant de fichiers et tu ne nous dis pas sur combien de lignes tu fais le traitement. En tout cas ce qui me semble louche c'est que tu utilises des tableaux de Strings. Pourquoi pas des tableaux de variants ? cela explique peut être le souci avec les dates.
Si tu avais le même type de test avec un seul fichier et facile à reproduire, on y verrait plus clair.

Ami calmant, J.P

**eric4459** · 04/08/2016, 00h04

Salut JP,
Je fais le test avec variant demain et te tiens au courant. Pour le nombre de lignes ce n'est pas énorme, quelques 800, mais comme je fais deux boucles imbriquées de 0 à 800 en gros il m´a semblé intéressant d'utiliser les variables tableau.

Éric

**pijaku** · 04/08/2016, 08h48

Bonjour Eric, JP, le forum,

En fait, tu dis travailler avec des variables tableaux, c'est le cas, mais tu ne travailles pas réellement en mémoire.
Pour que tu puisses gagner du temps d'exécution avec tes variables tableaux, il faut que tes données soient en mémoire et non dans les cellules.

Exemples :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
'Ici, tu boucles sur une variable tableau. OK
For j = 0 To UBound(Table1)
    'Mais tu lis le contenu des cellules
    Table1(j, 0) = Dlv2.Offset(j, 0)
    Table1(j, 1) = Dlv2.Offset(j, 6)
    Table1(j, 2) = Dlv2.Offset(j, 24)
    Table1(j, 3) = Dlv2.Offset(j, 25)
Next j

Même chose pour ta Table2.

Pour réellement gagner du temps d'exécution, tu devrais placer toutes tes données dans deux variables tableaux.

Exemple, avec ces deux lignes de code, tu places, en mémoire, dans une variable tableau, toutes les données de la feuille Src :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Dim mesDatasSrc() As Variant
mesDatasSrc = Src.Range("B10:Z" & NbLine2).Value

Tu fais la même chose avec la feuille Dest :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Dim mesDatasDest() As Variant
mesDatasDest = Dest.Range("B10:Z" & NbLine3).Value

Ensuite, ne te reste plus qu'à boucler :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
For j = 0 To UBound(mesDatasSrc, 1)
    For k = 0 To UBound(mesDatasDest, 1)
        If mesDatasDest(k, 0) = mesDatasSrc(j, 0) And mesDatasDest(k, 1) = mesDatasSrc(j, 1) Then
           Dlv1.Offset(k, 15) = mesDatasSrc(j, 24) 'A NOTER : on a toutes les colonnes dans la variable tableau. D'ou le 24 A VERIFIER
           'Dlv1.Offset(k, 15).NumberFormat = "[$-409]dd-mmm-yy;@"
           Dlv1.Offset(k, 16) = mesDatasSrc(j, 25) 'A NOTER : on a toutes les colonnes dans la variable tableau. D'ou le 25 A VERIFIER
           'Dlv1.Offset(k, 16).NumberFormat = "[$-409]dd-mmm-yy;@"
        End If
    Next k
Next j

Remarque : ici, on écrit dans les cellules, donc penser à ajouter avant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.ScreenUpdating = False

et après :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.ScreenUpdating = True

Comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Application.ScreenUpdating = False
For j = 0 To UBound(mesDatasSrc, 1)
    For k = 0 To UBound(mesDatasDest, 1)
        '......
    Next k
Next j
Application.ScreenUpdating = True

Quant au formatage des colonnes 15 et 16, je le ferais, en une seule fois, avant ou après.

Une dernière chose, pour tester :
- ouvre un nouveau classeur excel
- copie/colle ce code
- change le chemin pour celui d'un répertoire contenant pas mal de fichiers
- et réalise les deux tests.

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
Sub test()
Dim Fld As String
Dim Tb() As String
Dim i As Long
Dim t As Double
'le test1 va stocker les infos dans une variable tableau
'puis les restituer dans la feuille en un seul traitement
    t = Timer
    Fld = Dir("F:\Mes documents restaurés\TRAVAIL\URGENT EN COURS\Bureau 2016\", vbDirectory)
    Do While Fld <> ""
        'place en mémoire les infos
        i = i + 1
        ReDim Preserve Tb(0 To i)
        Tb(i) = Fld
        Fld = Dir
    Loop
    'restitution
    Range("A1").Resize(UBound(Tb), 1) = Application.Transpose(Tb)
    Debug.Print Timer - t
End Sub
 
Sub test_2()
Dim Fld As String
Dim Tb() As String
Dim i As Long
Dim t As Double
'le test2 va restituer au fur et à mesure les infos dans les cellules
    t = Timer
    Fld = Dir("F:\Mes documents restaurés\TRAVAIL\URGENT EN COURS\Bureau 2016\", vbDirectory)
    Do While Fld <> ""
        Range("B1").Offset(i, 0) = Fld
        Fld = Dir
        i = i + 1
    Loop
    Debug.Print Timer - t
End Sub

**eric4459** · 04/08/2016, 11h45

Bonjour JP, Franck, le Forum
JP en déclarant mes tableaux en "Variant", le format est bien pris en compte.
Franck
J'ai testé ta proposition mais il doit manquer quelque chose car quand j'arrive sur la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If mesDataDest(k, 0) = mesDataSrc(j, 0) And mesDataDest(k, 1) = mesDataSrc(j, 1) Then

pour une valeur de j et de k à 0, J'ai un message d'erreur "Run-time error 9 : Subscript out of Range"
En allant voir dans l'aide il semblerait que ce soit un dû à un problème de déclaration, j'ai donc essayé ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ReDim mesDataSrc(0 To Limit, 27)

mais sans succès, une idée de ce qui pourrait être la cause de cette erreur?
Merci pour votre aide
Eric

**pijaku** · 04/08/2016, 12h03

C'est de ma faute...
Cette façon de remplir une variable tableau

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

mesDatasSrc = Src.Range("B10:Z" & NbLine2).Value

implique que la variable tableau créée est en Base 1 et non en base 0.

Par conséquent :
> il te faut boucler à partir du premier indice (utilise LBound => toujours plus sur)
> la première "colonne" de ta variable tableau n'est plus 0, mais 1.
Donc il te faudra probablement changer toutes les colonnes indiquées en chiffres (en dur) dans le code.
Soit peut être quelque chose comme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
For j = LBound(mesDatasSrc, 1) To UBound(mesDatasSrc, 1)
    For k = LBound(mesDatasDest, 1) To UBound(mesDatasDest, 1)
        If mesDatasDest(k, 1) = mesDatasSrc(j, 1) And mesDatasDest(k, 2) = mesDatasSrc(j, 2) Then
           Dlv1.Offset(k, 15) = mesDatasSrc(j, 25) 'A NOTER : on a toutes les colonnes dans la variable tableau. D'ou le 25 A VERIFIER
           'Dlv1.Offset(k, 15).NumberFormat = "[$-409]dd-mmm-yy;@"
           Dlv1.Offset(k, 16) = mesDatasSrc(j, 26) 'A NOTER : on a toutes les colonnes dans la variable tableau. D'ou le 26 A VERIFIER
           'Dlv1.Offset(k, 16).NumberFormat = "[$-409]dd-mmm-yy;@"
        End If
    Next k
Next j

Code avec utilisation de variables tableaux

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager