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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
| Option Explicit
Public Type Group
Ceiling As Long
Date_Issued As String
Force As Long
KeyWord As String
Position As Long
Time_Issued As Date
ValidityBeginDate As String
ValidityBeginTime As Date
ValidityEndDate As String
ValidityEndTime As Date
Visibility As Long
Wind As Long
End Type
Function getArrayFromCells(Cells As Range)
Dim Counter As Long
Dim t()
ReDim t(1 To Cells.Count)
For Counter = 1 To UBound(t)
t(Counter) = Cells(Counter).Value
Next
getArrayFromCells = t
End Function
Sub Extract()
Dim Separators
Dim Data As String
Dim Datas
Dim IssuedDate As String
Dim IssuedTime As Date
Dim Counter As Long
Dim NewGroup As Group
Dim Groups() As Group
Data = Feuil2.Range("a2").Value
IssuedDate = Left(Data, 2)
IssuedTime = Mid(Data, 3, 2) / 24 + Mid(Data, 5, 2) / 1440
Data = Replace(Data, Left(Data, 8), "")
Separators = getArrayFromCells(Range("t_Bornes[Borne]"))
Datas = getDatas(Data, Separators, ";")
ReDim Groups(UBound(Datas))
For Counter = 0 To UBound(Datas)
Groups(Counter) = getGroup(Trim(Datas(Counter)), IssuedDate, IssuedTime, Counter + 1)
Next
PutGroupsInTable Groups
End Sub
Sub PutGroupsInTable(ByRef Groups() As Group)
Dim Counter As Long
For Counter = LBound(Groups) To UBound(Groups)
PutGroupInTable Groups(Counter)
Next
End Sub
Sub PutGroupInTable(Group As Group)
Dim NewRow As ListRow
Set NewRow = Range("t_Groupes").ListObject.ListRows.Add()
With Group
NewRow.Range(1).Value = .Position
NewRow.Range(2).Value = .KeyWord
NewRow.Range(3).Value = .Date_Issued
NewRow.Range(4).Value = .Time_Issued
NewRow.Range(5).Value = .ValidityBeginDate
NewRow.Range(6).Value = .ValidityBeginTime
NewRow.Range(7).Value = .ValidityEndDate
NewRow.Range(8).Value = .ValidityEndTime
NewRow.Range(9).Value = .Wind
NewRow.Range(10).Value = .Force
NewRow.Range(11).Value = .Visibility
NewRow.Range(12).Value = .Ceiling
End With
End Sub
Function getDatas(ByVal Value As String, ByVal Separators, ByVal separator As String)
Dim Cell As Range
Dim Counter As Long
For Counter = 1 To Range("t_Bornes[borne]").Count
Value = Replace(Value, Range("t_Bornes[borne]")(Counter).Value, separator & "Group" & Counter)
Next
For Counter = 1 To Range("t_Bornes[borne]").Count
Value = Replace(Value, "Group" & Counter, Replace(Range("t_Bornes[borne]")(Counter).Value, " ", "_"))
Next
getDatas = Split(Value, separator)
End Function
Function getGroup(ByRef Data, ByVal IssuedDate As String, IssuedTime As Date, ByVal Position) As Group
Dim G As Group
G.Position = Position
G.Date_Issued = IssuedDate
G.Time_Issued = IssuedTime
SetCeiling G, Data
SetKeyWord G, Data
setValidities G, Data
SetVisibility G, Data
SetWindForce G, Data
getGroup = G
End Function
Sub SetCeiling(ByRef G As Group, ByVal Data As String)
Dim Pos As Long
Pos = InStr(1, Data, "BKN")
If Pos > 0 Then G.Ceiling = Mid(Data, Pos + 4, 2) * 100
End Sub
Sub SetKeyWord(ByRef G As Group, ByVal Data As String)
If G.Position > 1 Then G.KeyWord = Replace(Left(Data, InStr(1, Data, " ") - 1), "_", " ")
End Sub
Sub setValidities(ByRef G As Group, ByVal Data As String)
Dim Pos As Long
If G.Position = 1 Then
Pos = 1
Else
Pos = InStr(1, Data, " ") + 1
End If
With G
.ValidityBeginDate = Mid(Data, Pos, 2)
.ValidityBeginTime = Mid(Data, Pos + 2, 2) / 24
.ValidityEndDate = Mid(Data, Pos + 5, 2)
.ValidityEndTime = IIf(Mid(Data, Pos + 7, 2) = "24", TimeSerial(23, 59, 59), Mid(Data, Pos + 7, 2) / 24)
End With
End Sub
Sub SetVisibility(ByRef G As Group, ByVal Data As String)
Dim Pos As Long
Pos = InStr(1, Data, "KT")
If Pos > 0 And Pos < Len(Data) - 6 Then G.Visibility = Mid(Data, Pos + 3, 4)
End Sub
Sub SetWindForce(ByRef G As Group, ByVal Data As String)
Dim Pos As Long
Pos = InStr(1, Data, "KT")
If Pos > 0 Then
G.Wind = Mid(Data, Pos - 5, 3)
G.Force = Mid(Data, Pos - 2, 2)
End If
End Sub |
Décoder messages sous VBA
Répondre avec citation
: ça peut servir aux autres 
Envoyé par patricktoulon
Partager