Code avec utilisation de variables tableaux

Version imprimable

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:

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:

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

03/08/2016, 23h21
jurassic pork

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
04/08/2016, 00h04
eric4459

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

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:

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:

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

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

Code:

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

Ensuite, ne te reste plus qu'à boucler :

Code:

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:

Application.ScreenUpdating = False

et après :

Code:

Application.ScreenUpdating = True

Comme ceci :

Code:

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:

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

04/08/2016, 11h45
eric4459

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:

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:

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

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

Code:

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:

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

Salut Franck,
Ça fonctionne parfaitement comme cela, voici ce que j'ai mis

Code:

1
2
3
4
5
6
7
8
9
10
11
For j = LBound(mesDataSrc, 1) To UBound(mesDataSrc, 1)
    For k = LBound(mesDataDest, 1) To UBound(mesDataDest, 1)
        'Tableau commence en B10 donc colonne 1 du tableau correspond à la colonne B : (j, 1)-> colonne B, (k, 7) -> colonne H
        If mesDataDest(k, 1) = mesDataSrc(j, 1) And mesDataDest(k, 7) = mesDataSrc(j, 7) Then
           Dlv1.Offset(k, 15) = mesDataSrc(j, 25) 'Tableau commence en B10 donc colonne 1 du tableau correspond à la colonne B : (j,25)-> colonne Z
           Dlv1.Offset(k, 15).NumberFormat = "[$-409]dd-mmm-yy;@"
           Dlv1.Offset(k, 16) = mesDataSrc(j, 26) 'Tableau commence en B10 donc colonne 1 du tableau correspond à la colonne B : (j,26)-> colonne AA
           Dlv1.Offset(k, 16).NumberFormat = "[$-409]dd-mmm-yy;@"
        End If
    Next k
Next j

J'ai également dû changé mes références

Code:

1
2
Set Dlv1 = Dest.Range("B9") 'Passé en B9 car LBound du tableau = 1 donc les variables j et k varient de 1 à UBound
Set Dlv2 = Src.Range("B9") 'Passé en B9 car LBound du tableau = 1 donc les variables j et k varient de 1 à UBound

Petite question subsidiaire :
Dans certains Posts et dans certains tutoriels j'ai vu que l'on utilisait

Code:

ReDim

Je l'ai donc appliqué dans mon premier test et cela semblait fonctionner

Code:

ReDim Table1(0 To Limit, 3)

Pourquoi ne pas utiliser cette fonction ici?
Quand utiliser cette fonction à bon escient?

Eric

04/08/2016, 13h23
pijaku

ReDim

Citation:

ReDim sert pour:
* Redéfinir le nombre d'éléments.
* Changer le nombre de dimensions.
* Etablir les limites supérieures et inférieures de chaque dimension.

A lire absolument