Calcul avec les données issue d'un tableau

**eric4459** · 30/08/2018, 18h31

Bonjour à tous,
Je cherche à comparer a soustraire des données d'un tableau à deux dimensions que j'ai alimenté mais me retrouve avec un soucis.
Voici mon 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
117
118
119
120
121
122
123
124
125
126
127
Sub Progress_ Delivery()
 
Dim wkA As Workbook, wkB As Workbook
Dim ICT As Worksheet
Dim TASK As Worksheet
Dim File_Path As String, Name_File As String
Dim Id_IO As Range
Dim Id_CMA As Range
Dim NbLine1 As Integer
Dim NbLine2 As Integer
Dim NbCol1 As Integer
Dim NbCol2 As Integer
Dim L1 As Integer
Dim L2 As Integer
Dim C1 As Integer
Dim C2 As Integer
Dim i As Integer
Dim j As Integer
Set wkA = ThisWorkbook
Set ICT = wkA.Sheets("Analysis_ICT")
Set Id_IO = ICT.Range("J2")
j = 0
 
 Dim T As Double
 T = Timer
 
Application.ScreenUpdating = False
 
Application.DisplayAlerts = False 'désactive les fenetres de demande de confirmation avant suppression
 
 
With ICT
    NbLine1 = Range("A1").SpecialCells(xlCellTypeLastCell).Row
    NbCol1 = Range("A1").SpecialCells(xlCellTypeLastCell).Column
End With
 
File_Path = ThisWorkbook.Path
Name_File = "F1551A-Activities.xlsx"
Workbooks.Open File_Path & "\" & Name_File
 
Columns(1).Insert
Columns(6).Insert
Range("F2") = "New_IO_Date"
Columns(10).Insert
Range("J2") = "New_Total_Float"
 
Set wkB = ActiveWorkbook
Set TASK = ActiveWorkbook.Sheets("TASK")
Set Id_CMA = TASK.Range("A2")
 
With TASK
    NbLine2 = Range("B1").SpecialCells(xlCellTypeLastCell).Row
    NbCol2 = Range("B1").SpecialCells(xlCellTypeLastCell).Column
End With
 
Dim Table1(1 To 4000, 1 To 10) As String 'Declare Table1
Dim Table2(1 To 4000, 1 To 13) As String 'Declare Table2
 
'**********************************IO Table*************************************
 
For L1 = 1 To UBound(Table1, 1)
    For C1 = 1 To UBound(Table1, 2)
        Id_IO.Offset(L1, C1) = Replace(Id_IO.Offset(L1, C1), Chr(34), "")
        Table1(L1, C1) = Id_IO.Offset(L1, C1)
        'Debug.Print Table1(L1, C1)
        'Use Table1(L1,1)-> Project ID / Table1(L1,2)-> Activity ID / Table1(L1,3)->Activity Name
        'Use Table1(L1,6) -> Status / Table1(L1,7)->  Delivery Date ( Use Left(Table1(L1,7),10)) / Table1(L1,8)->  New Delivery Date ( Use Left(Table1(L1,8),10))
    Next C1
Next L1
 
'*********************************CMA Table*************************************
 
For L2 = 1 To UBound(Table2, 1)
    For C2 = 1 To UBound(Table2, 2)
        Table2(L2, C2) = Id_CMA.Offset(L2, C2)
        'Debug.Print Table2(L2, C2)
        'Use Table2(L2,1)-> Activity ID / Table2(L2,2)-> Status / Table2(L2,4)->Activity Name / Table2(L2,5)-> New_IO_Date
        'Use Table2(L2,6) -> Delivery Date ( Use Left(Table1(L2,6),10))/ Table2(L2,9) -> New Total_Float / Table2(L2,10)->  Total Float
        'Use Table2(L2, 5)to store temporary result that will be later feeding Id_CMA.Offset(j, 5)
        'Use Table2(L2, 9)to store temporary result that will be later feeding Id_CMA.Offset(j, 8)
 
 
    Next C2
Next L2
 
'**********************************Format Date from P6***************************
For i = 0 To NbLine2
    Id_CMA.Offset(i, 6) = Replace(Id_CMA.Offset(i, 6), "/", "-")
Next i
 
'**********************************Comparison Loop*******************************
 
    For L1 = 1 To UBound(Table1, 1)
        If Table1(L1, 1) = "F1551A" Then
            For i = 0 To NbLine2
                For L2 = 1 To UBound(Table2, 1)
                    If Table1(L1, 2) Like Table2(L2, 1) And Table1(L1, 7) <> Table2(L2, 6) And Table1(L1, 6) <> "Complete" Then
                        Table2(L2, 5) = Left(Table1(L1, 8), 10)
                        If Left(Table1(L1, 8), 10) - Left(Table1(L1, 7), 10) > 0 Then
                            Table2(L2, 9) = Table2(L2, 10) + (Left(Table1(L1, 8), 10) - (Left(Table1(L1, 7), 10)) * 5 / 7)
                            j = j + 1
                        ElseIf Left(Table1(L1, 8), 10) - Left(Table1(L1, 7), 10) < 0 Then
                            Table2(L2, 9) = Table2(L2, 10) - (Left(Table1(L1, 8), 10) - (Left(Table1(L1, 7), 10)) * 5 / 7)
                            j = j + 1
                        End If
                    End If
                Next L2
            Next i
        End If
    Next L1
 
    For i = 0 To NbLine2
        For L2 = 1 To UBound(able2, 2)
            Id_CMA.Offset(i, 6) = Table2(L2, 5)
            'Id_CMA.Offset(i, 6).NumberFormat = "dd/mm/yyy"
            Id_CMA.Offset(i, 9) = Table2(L2, 9)
        Next L2
    Next i
 
MsgBox ("There was " & j & " changes applied")
MsgBox Application.Round((Timer - T), 1) & " Sec"
 
Application.ScreenUpdating = True
 
Application.DisplayAlerts = True
 
End Sub

J'ai une erreur Type Mismatch sur

Nom : VBA1.JPG
Affichages : 175
Taille : 14,0 Ko

Nom : VBA2.JPG
Affichages : 177
Taille : 10,1 Ko

Je pense que cette erreur vient du fait que les données sont entre guillemets, elles contiennent des dates au format "dd/mm/yyyy hh:mn".
J'ai essayé

Code :

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

Id_IO.Offset(L1, C1) = Replace(Id_IO.Offset(L1, C1), Chr(34), "")

Sans succès

Code :

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

 If Left(Table1(L1, 8), 10).Value - Left(Table1(L1, 7), 10).Value > 0 Then

Mais j'ai une erreur Object Required

Nom : VBA3.JPG
Affichages : 178
Taille : 10,0 Ko

Quelqu'un a-t-il une idée sur la cause de mon problème?

Merci pour votre aide et vos conseils

Eric

**anasecu** · 30/08/2018, 21h31

Bonjour,

Envoyé par eric4459

Je pense que cette erreur vient du fait que les données sont entre guillemets, elles contiennent des dates au format "dd/mm/yyyy hh:mn".

Si c'est des dates à comparer autant les transformer en vraies dates et non essayer de soustraire du texte

Code :

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

 If datevalue(Table1(L1, 8) - datevalue(Table1(L1, 7) > 0 Then

**eric4459** · 30/08/2018, 22h17

Bonsoir et merci, je vais essayer demain et te tiendrai au courant.
Eric

**eric4459** · 31/08/2018, 14h57

anasecu,
Merci cela solutionne mon problème en partie.
Voici mon code, apr`s nettoyage de quelques c..ries

(boucle inutiles que j'avais oublié et autres)

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
117
118
119
120
121
122
123
124
125
126
127
128
129
Sub Progress_IO_Delivery()
 
Dim wkA As Workbook, wkB As Workbook
Dim ICT As Worksheet
Dim TASK As Worksheet
Dim File_Path As String, Name_File As String
Dim Id_IO As Range
Dim Id_CMA As Range
Dim NbLine1 As Integer
Dim NbLine2 As Integer
Dim NbCol1 As Integer
Dim NbCol2 As Integer
Dim L1 As Integer
Dim L2 As Integer
Dim C1 As Integer
Dim C2 As Integer
Dim i As Integer
Dim j As Integer
Set wkA = ThisWorkbook
Set ICT = wkA.Sheets("Analysis_ICT")
Set Id_IO = ICT.Range("J2")
j = 0
 
 Dim T As Double
 T = Timer
 
Application.ScreenUpdating = False
 
Application.DisplayAlerts = False 'désactive les fenetres de demande de confirmation avant suppression
 
 
With ICT
    NbLine1 = Range("A1").SpecialCells(xlCellTypeLastCell).Row
    NbCol1 = Range("A1").SpecialCells(xlCellTypeLastCell).Column
End With
 
File_Path = ThisWorkbook.Path
Name_File = "F1551A-Activities.xlsx"
Workbooks.Open File_Path & "\" & Name_File
 
Columns(1).Insert
Columns(6).Insert
Range("F2") = "New_IO_Date"
Columns(10).Insert
Range("J2") = "New_Total_Float"
 
Set wkB = ActiveWorkbook
Set TASK = ActiveWorkbook.Sheets("TASK")
Set Id_CMA = TASK.Range("A2")
 
With TASK
    NbLine2 = Range("B1").SpecialCells(xlCellTypeLastCell).Row
    NbCol2 = Range("B1").SpecialCells(xlCellTypeLastCell).Column
End With
 
Dim Table1(1 To 4000, 1 To 10) As String 'Declare Table1
Dim Table2(1 To 4000, 1 To 13) As String 'Declare Table2
 
'**********************************IO Table*************************************
 
For L1 = 1 To UBound(Table1, 1)
    For C1 = 1 To UBound(Table1, 2)
        If Id_IO.Offset(L1, 0) <> "" Then
            Table1(L1, C1) = Id_IO.Offset(L1, C1)
        End If
        'Debug.Print Table1(L1, C1)
        'Use Table1(L1,1)-> Project ID / Table1(L1,2)-> Activity ID / Table1(L1,3)->Activity Name
        'Use Table1(L1,6) -> Status / Table1(L1,7)->  Delivery Date ( Use Left(Table1(L1,7),10)) / Table1(L1,8)->  New Delivery Date ( Use Left(Table1(L1,8),10))
    Next C1
Next L1
 
'*********************************CMA Table*************************************
 
For L2 = 1 To UBound(Table2, 1)
    For C2 = 1 To UBound(Table2, 2)
        If Id_CMA.Offset(L2, 1) <> "" Then
            Table2(L2, C2) = Id_CMA.Offset(L2, C2)
        End If
        'Debug.Print Table2(L2, C2)
        'Use Table2(L2,1)-> Activity ID / Table2(L2,2)-> Status / Table2(L2,4)->Activity Name / Table2(L2,5)-> New_IO_Date
        'Use Table2(L2,6) -> Delivery Date ( Use Left(Table1(L2,6),10))/ Table2(L2,9) -> New Total_Float / Table2(L2,10)->  Total Float
        'Use Table2(L2, 5)to store temporary result that will be later feeding Id_CMA.Offset(j, 5)
        'Use Table2(L2, 9)to store temporary result that will be later feeding Id_CMA.Offset(j, 8)
    Next C2
Next L2
 
'**********************************Format Date from P6***************************
For i = 0 To NbLine2
    Id_CMA.Offset(i, 6) = Replace(Id_CMA.Offset(i, 6), "/", "-")
    Id_CMA.Offset(i, 6).NumberFormat = "dd-mmm-yyyy"
Next i
 
'**********************************Comparison Loop*******************************
 
    For L1 = 1 To UBound(Table1, 1)
        If Table1(L1, 1) = "F1551A" Then
            For L2 = 1 To UBound(Table2, 1)
                If Table1(L1, 2) Like Table2(L2, 1) And Table1(L1, 7) <> Table2(L2, 6) And Table1(L1, 6) <> "Complete" Then
                    Table2(L2, 5) = Left(Table1(L1, 8), 10)
                    Id_CMA.Offset(L2, 5) = Table2(L2, 5)
                    Id_CMA.Offset(L2, 5) = Replace(Id_CMA.Offset(L2, 5), "/", "-")
                    Id_CMA.Offset(i, 6).NumberFormat = "dd-mm-yyyy"
                    If DateValue(Left(Table1(L1, 8), 10)) - DateValue(Left(Table1(L1, 7), 10)) > 0 Then
                        Table2(L2, 9) = Table2(L2, 10) + (DateValue(Left(Table1(L1, 8), 10)) - DateValue(Left(Table1(L1, 7), 10)) * 5 / 7)
                        Id_CMA.Offset(L2, 9) = Table2(L2, 9)
                        Id_CMA.Offset(L2, 9) = Replace(Id_CMA.Offset(L2, 9), "/", "-")
                        Id_CMA.Offset(L2, 9).NumberFormat = "0,00"
                        j = j + 1
                    ElseIf DateValue(Left(Table1(L1, 8), 10)) - DateValue(Left(Table1(L1, 7), 10)) < 0 Then
                        Table2(L2, 9) = Table2(L2, 10) - (DateValue(Left(Table1(L1, 8), 10)) - DateValue(Left(Table1(L1, 7), 10)) * 5 / 7)
                        Id_CMA.Offset(L2, 9) = Table2(L2, 9)
                        Id_CMA.Offset(L2, 9) = Replace(Id_CMA.Offset(L2, 9), "/", "-")
                        Id_CMA.Offset(L2, 9).NumberFormat = "0,00"
                        j = j + 1
                    End If
                End If
            Next L2
        End If
    Next L1
 
 
MsgBox ("There was " & j & " changes applied")
MsgBox Application.Round((Timer - T), 1) & " Sec"
 
Application.ScreenUpdating = True
 
Application.DisplayAlerts = True
 
End Sub

Pourtant, bien que maintenant je nái plus dérreurs liées à mes tableaux, la séquence suivante me retourne parfois un mauvais format

Code :

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

1
2
3
4
5
6
Id_CMA.Offset(L2, 5) = Table2(L2, 5)
                    Id_CMA.Offset(L2, 5) = Replace(Id_CMA.Offset(L2, 5), "/", "-")
                    Id_CMA.Offset(i, 6).NumberFormat = "dd-mm-yyyy"
                    Id_CMA.Offset(L2, 9) = Table2(L2, 9)
                    Id_CMA.Offset(L2, 9) = Replace(Id_CMA.Offset(L2, 9), "/", "-")
                    Id_CMA.Offset(L2, 9).NumberFormat = "0,00"

Nom : VBA5.JPG
Affichages : 142
Taille : 11,8 Ko

Nom : VBA4.JPG
Affichages : 140
Taille : 17,6 Ko

Nom : VBA6.JPG
Affichages : 136
Taille : 63,0 Ko

Quelle pourrais être la solution?

Eric

**anasecu** · 31/08/2018, 18h57

Bonjour,

Envoyé par eric4459

Pourtant, bien que maintenant je nái plus dérreurs liées à mes tableaux, la séquence suivante me retourne parfois un mauvais format

Je pense que tu as un problème de conversion lié au format natif et donc j'essayerai

Code :

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

1
2
3
4
5
6
Id_CMA.Offset(L2, 5) = Table2(L2, 5)
                    Id_CMA.Offset(L2, 5) = Cdate(Replace(Id_CMA.Offset(L2, 5), "/", "-"))
                    Id_CMA.Offset(i, 6).NumberFormat = "dd-mm-yyyy"
                    Id_CMA.Offset(L2, 9) = Table2(L2, 9)
                    Id_CMA.Offset(L2, 9) = Cdate(Replace(Id_CMA.Offset(L2, 9), "/", "-"))
                    Id_CMA.Offset(L2, 9).NumberFormat = "0,00"

Si le Cdate est en erreur rajoute le datevalue

Code :

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

                   Id_CMA.Offset(L2, 5) = Cdate(datevalue(Replace(Id_CMA.Offset(L2, 5), "/", "-")))

**eric4459** · 07/09/2018, 16h48

Bonjour anasecu,
Merci pour ton aide, j'ai finalement résolu mon problème en agissant directement dans mes tableaux lors du chargement de ceux-ci.

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
'**********************************IO Table*************************************
 
For L1 = 1 To UBound(Table1, 1)
    For C1 = 1 To UBound(Table1, 2)
        If Id_IO.Offset(L1, 0) <> "" Then
            Table1(L1, C1) = Id_IO.Offset(L1, C1)
        End If
 
        'Use Table1(L1,1)-> Project ID / Table1(L1,2)-> Activity ID / Table1(L1,3)->Activity Name
        'Use Table1(L1,6) -> Status / Table1(L1,7)->  Delivery Date ( Use Left(Table1(L1,7),10)) / Table1(L1,8)->  New Delivery Date ( Use Left(Table1(L1,8),10))
    Next C1
    If Id_IO.Offset(L1, 9) <> "-" And Id_IO.Offset(L1, 9) <> "" Then
        Table1(L1, 7) = CDate(Left(Id_IO.Offset(L1, 7), 10))
        Table1(L1, 8) = CDate(Left(Id_IO.Offset(L1, 8), 10))
        'Debug.Print Table1(L1, 7)
    End If
Next L1
 
'*********************************CMA Table*************************************
 
For L2 = 1 To UBound(Table2, 1)
    For C2 = 1 To UBound(Table2, 2)
        If Id_CMA.Offset(L2, 1) <> "" Then
            Table2(L2, C2) = Id_CMA.Offset(L2, C2)
        End If
        'Use Table2(L2,1)-> Activity ID / Table2(L2,2)-> Status / Table2(L2,4)->Activity Name / Table2(L2,5)-> New_IO_Date
        'Use Table2(L2,6) -> Delivery Date ( Use Left(Table1(L2,6),10))/ Table2(L2,9) -> New Total_Float / Table2(L2,10)->  Total Float
        'Use Table2(L2, 5)to store temporary result that will be later feeding Id_CMA.Offset(j, 5)
        'Use Table2(L2, 9)to store temporary result that will be later feeding Id_CMA.Offset(j, 8)
    Next C2
        Table2(L2, 6) = CDate(Id_CMA.Offset(L2, 6))
        'Debug.Print Table2(L2, 6)
Next L2

Cela simplifie également mon code final.

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
117
118
119
120
121
122
123
Sub Progress_IO_Delivery()
 
Dim wkA As Workbook, wkB As Workbook
Dim ICT As Worksheet
Dim TASK As Worksheet
Dim File_Path As String, Name_File As String
Dim Id_IO As Range
Dim Id_CMA As Range
Dim NbLine1 As Integer
Dim NbLine2 As Integer
Dim NbCol1 As Integer
Dim NbCol2 As Integer
Dim L1 As Integer
Dim L2 As Integer
Dim C1 As Integer
Dim C2 As Integer
Dim i As Integer
Dim j As Integer
Set wkA = ThisWorkbook
Set ICT = wkA.Sheets("Analysis_ICT")
Set Id_IO = ICT.Range("J2")
j = 0
 
Application.ScreenUpdating = False
 
Application.DisplayAlerts = False 'désactive les fenetres de demande de confirmation avant suppression
 
 
With ICT
    NbLine1 = Range("A1").SpecialCells(xlCellTypeLastCell).Row
    NbCol1 = Range("A1").SpecialCells(xlCellTypeLastCell).Column
End With
 
File_Path = ThisWorkbook.Path
Name_File = "F1551A-Activities.xlsx"
Workbooks.Open File_Path & "\" & Name_File
 
Columns(1).Insert
Columns(6).Insert
Range("F2") = "New_IO_Date"
Columns(10).Insert
Range("J2") = "New_Total_Float"
 
Set wkB = ActiveWorkbook
Set TASK = ActiveWorkbook.Sheets("TASK")
Set Id_CMA = TASK.Range("A2")
 
With TASK
    NbLine2 = Range("B1").SpecialCells(xlCellTypeLastCell).Row
    NbCol2 = Range("B1").SpecialCells(xlCellTypeLastCell).Column
End With
 
Dim Table1(1 To 4000, 1 To 10) As String 'Declare Table1
Dim Table2(1 To 4000, 1 To 13) As String 'Declare Table2
 
'**********************************IO Table*************************************
 
For L1 = 1 To UBound(Table1, 1)
    For C1 = 1 To UBound(Table1, 2)
        If Id_IO.Offset(L1, 0) <> "" Then
            Table1(L1, C1) = Id_IO.Offset(L1, C1)
        End If
 
        'Use Table1(L1,1)-> Project ID / Table1(L1,2)-> Activity ID / Table1(L1,3)->Activity Name
        'Use Table1(L1,6) -> Status / Table1(L1,7)->  Delivery Date ( Use Left(Table1(L1,7),10)) / Table1(L1,8)->  New Delivery Date ( Use Left(Table1(L1,8),10))
    Next C1
    If Id_IO.Offset(L1, 9) <> "-" And Id_IO.Offset(L1, 9) <> "" Then
        Table1(L1, 7) = CDate(Left(Id_IO.Offset(L1, 7), 10))
        Table1(L1, 8) = CDate(Left(Id_IO.Offset(L1, 8), 10))
        'Debug.Print Table1(L1, 7)
    End If
Next L1
 
'*********************************CMA Table*************************************
 
For L2 = 1 To UBound(Table2, 1)
    For C2 = 1 To UBound(Table2, 2)
        If Id_CMA.Offset(L2, 1) <> "" Then
            Table2(L2, C2) = Id_CMA.Offset(L2, C2)
        End If
        'Use Table2(L2,1)-> Activity ID / Table2(L2,2)-> Status / Table2(L2,4)->Activity Name / Table2(L2,5)-> New_IO_Date
        'Use Table2(L2,6) -> Delivery Date ( Use Left(Table1(L2,6),10))/ Table2(L2,9) -> New Total_Float / Table2(L2,10)->  Total Float
        'Use Table2(L2, 5)to store temporary result that will be later feeding Id_CMA.Offset(j, 5)
        'Use Table2(L2, 9)to store temporary result that will be later feeding Id_CMA.Offset(j, 8)
    Next C2
        Table2(L2, 6) = CDate(Id_CMA.Offset(L2, 6))
        'Debug.Print Table2(L2, 6)
Next L2
 
'**********************************Format Date from P6***************************
For i = 0 To NbLine2
    Id_CMA.Offset(i, 6) = Replace(Id_CMA.Offset(i, 6), "/", "-")
    Id_CMA.Offset(i, 6).NumberFormat = "dd-mmm-yyyy"
Next i
 
'**********************************Comparison Loop*******************************
 
    For L1 = 1 To UBound(Table1, 1)
        If Table1(L1, 1) = "F1551A" Then
            For L2 = 1 To UBound(Table2, 1)
                If Table1(L1, 2) Like Table2(L2, 1) And Table1(L1, 7) <> Table2(L2, 6) And Table1(L1, 6) <> "Complete" Then
                    Table2(L2, 5) = Left(Table1(L1, 8), 10)
                    Id_CMA.Offset(L2, 5) = LTrim(Table2(L2, 5))
                    'Id_CMA.Offset(L2, 5) = LTrim(Id_CMA.Offset(L2, 5))
                    If DateValue(Table1(L1, 8)) + DateValue(Table1(L1, 7)) > 0 Then
                        Table2(L2, 9) = Table2(L2, 10) - (DateValue(Table1(L1, 8)) - DateValue(Table1(L1, 7))) * 5 / 7
                        Id_CMA.Offset(L2, 9) = Table2(L2, 9)
                        j = j + 1
                    ElseIf DateValue(Table1(L1, 8)) - DateValue(Table1(L1, 7)) < 0 Then
                        Table2(L2, 9) = Table2(L2, 10) - (DateValue(Table1(L1, 8)) - DateValue(Table1(L1, 7))) * 5 / 7
                        Id_CMA.Offset(L2, 9) = Table2(L2, 9)
                        j = j + 1
                    End If
                End If
            Next L2
        End If
    Next L1
 
Application.ScreenUpdating = True
 
Application.DisplayAlerts = True
 
End Sub

Merci encore

Eric

Calcul avec les données issue d'un tableau

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager