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