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
| Sub InputFilePanam(Pos As Integer, v1 As Integer, v2 As Integer, vSiteReal As String, ByVal WsCléPANAM As String)
Dim i As Long, Lg As Long: Dim j As Long
Dim cl As Integer
Dim temp As Variant
Dim vDateDeb As Date
Dim vDateFin As Date
Dim wbREF As String, WbPan As String
'====Calcul variable Delta====
OpenVariableDelta
'====Recuperation date de debut et fin outil====
temp = Split(Ihm_Panam.LB_Param.Caption, "|")
vDateDeb = temp(0)
vDateFin = temp(1)
'====Initialisation des variables====
FlagTot = 0
FlagInf = 0
FlagSup = 0
'====Recuperation des données du fichier====
Application.ScreenUpdating = False
wbREF = ActiveWorkbook.Name
Workbooks.Open filename:=CStr(Ihm_Panam.ListBox1.List(Pos, 0)), ReadOnly:=True
WbPan = ActiveWorkbook.Name
'Workbooks(WbPan).Activate
temp = Split(Cells(3, 1).value, "|")
L1 = temp(1)
L2 = temp(2) & "-" & temp(3)
temp = Split(Cells(5, 1).value, "|")
l3 = temp(1)
'YCT-modifié pour intégrer les fichiers .txt > 65000 lignes. passer de 65000 à 650000
Erase data
ReDim data(Cells(650000, 1).End(xlUp).Row - Pan_Lgdb, 6)
i = 1: j = 1
Do While Cells(i + Pan_Lgdb, 1).value <> ""
temp = Split(Cells(i + Pan_Lgdb, 1).value, "|")
If temp(Pan_Dat) <> "" And IsDate(temp(Pan_Dat)) And CStr(vSiteReal) >= temp(Pan_Sit) Then
data(j, 1) = CStr(temp(Pan_Sit))
data(j, 2) = CStr(temp(Pan_Ser))
data(j, 3) = CStr(temp(Pan_Cod))
data(j, 4) = CStr(Ihm_Panam.ListBox1.List(Pos, 1)) 'STF
data(j, 5) = CStr(temp(Pan_Flo))
data(j, 6) = CDate(temp(Pan_Dat))
j = j + 1
End If
i = i + 1
Loop
ActiveWorkbook.Close
'====Traitement des données====
Application.ScreenUpdating = False
Ihm_Progress.Caption = "Traitement de : " & WsCléPANAM
vDeb = Now
If v2 = 1 Then
Ihm_Progress.TX_Info.Caption = "Traitement et import du fichier...":
Else
Ihm_Progress.TX_Info.Caption = "Traitement et import des fichiers : " & v1 & "/" & v2
End If
For i = 1 To UBound(data, 1)
'Controle du site
If CStr(data(i, 1)) = CStr(vSiteReal) Then
' Optimisation : filte sur code site
' joh v5 suppression des blancs dans le code opération juin 2017
data(i, 3) = Trim(Replace(data(i, 3), " ", ""))
' joh v5 suppression des blancs dans le code opération juin 2017
'optimisation
If Lg <> 0 Then
If data(i, 2) & data(i, 3) & data(i, 4) & data(i, 5) <> data(i - 1, 2) & data(i - 1, 3) & data(i - 1, 4) & data(i - 1, 5) Then
Lg = ScanLine(i)
End If
Else
Lg = ScanLine(i)
End If
Chn.Cells(Lg, Chn_Ser) = data(i, 2)
Chn.Cells(Lg, Chn_Cod).NumberFormat = "@" 'Format texte pour les OM
Chn.Cells(Lg, Chn_Cod) = data(i, 3)
Chn.Cells(Lg, Chn_Com) = L1 & "-" & L2 & "-" & l3
Chn.Cells(Lg, Chn_Stf) = data(i, 4)
Chn.Cells(Lg, Chn_Flo) = data(i, 5)
'Controle des dates (appartient ou non à l'horizon)
'If DateValue(Data(i, 6)) < vDateDeb Then
If data(i, 6) < vDateDeb Then
FlagInf = FlagInf + 1
'ElseIf DateValue(Data(i, 6)) > vDateFin Then
ElseIf data(i, 6) > vDateFin Then
FlagSup = FlagSup + 1
Else
cl = ScanColumn(i)
If cl = -1 Then MsgBox "Alerte "
Chn.Cells(Lg, cl) = Chn.Cells(Lg, cl) + 1
End If
FlagTot = FlagTot + 1
End If
RefreshProgress
Next i
End Sub |
