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 : 177
Taille : 14,0 Ko
Nom : VBA2.JPG
Affichages : 180
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 : 180
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