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
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
| maxSeg = 30
maxStruct = 15
Set wbChoix = ActiveWorkbook
Set wsChoix = Sheets("choix")
wsChoix.Select
recLen = [A2]
Set structs = Range([D1], [D1].End(xlToRight))
Set conds = Range([D2], [D2].End(xlToRight))
Set vals = Range([D3], [D3].End(xlToRight))
Set tmp = Range([D4], [D4].End(xlToRight))
nbStruct = structs.Count
If tmp.Count <> nbStruct Or conds.Count <> nbStruct Or vals.Count <> nbStruct Then
Exit Sub
End If
filePath = Application.GetOpenFilename
If filePath = False Then
Exit Sub
End If
ReDim wsStruct(nbStruct - 1) As Worksheet
ReDim condPos(nbStruct - 1) As Long
ReDim condLen(nbStruct - 1) As Long
ReDim condUti(nbStruct - 1) As String
ReDim outRow(nbStruct - 1) As Long
ReDim structLen(nbStruct - 1) As Long
Dim convD(255) As String, conv3(255) As String
Sheets("ebcdic").Activate
For i = 0 To 255
convD(i) = Cells(i + 1, 4)
conv3(i) = Cells(i + 1, 2)
Next i
Workbooks.Add
Set wbNew = ActiveWorkbook
For i = 0 To nbStruct - 1
Sheets.Add
Set wsStruct(i) = ActiveSheet
ActiveSheet.Name = structs(i + 1)
Next i
minRead = 1
For i = 0 To nbStruct - 1
col = i + [D4].Column
row = [D4].row
wbChoix.Activate
wsChoix.Select
Sheets(Cells(row, col).Value).Select
For Each cell In Range([D2], [D2].End(xlDown))
If cell = conds(i + 1) Then
condPos(i) = Cells(cell.row, 9) - 1
condLen(i) = Cells(cell.row, 8)
condUti(i) = Cells(cell.row, 7)
Exit For
End If
Next cell
If condLen(i) = 0 Then
MsgBox "cond pas trouvée"
Exit Sub
End If
r = condPos(i) + condLen(i)
If r > minRead Then
minRead = r
End If
Range([O1].End(xlDown), [O1].End(xlToRight)).Copy
wbNew.Activate
wsStruct(i).Select
Cells(1, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
outRow(i) = [A1].End(xlDown).row + 1
Next i
If recLen = "" Then
ReDim bytes1(minRead - 1) As Byte
Else
ReDim bytes1(recLen - 1) As Byte
End If
maxLen = 2
For i = 0 To nbStruct - 1
col = i + [D4].Column
For j = 1 To maxSeg - 1
row = j + [D4].row
wbChoix.Activate
wsChoix.Select
If Cells(row, col) = "" Then
Exit For
End If
Sheets(Cells(row, col).Value).Select
Range([O1].End(xlDown), [O1].End(xlToRight)).Copy
wbNew.Activate
wsStruct(i).Select
structLen(i) = Cells(1, pasteCol - 1) + Cells(2, pasteCol - 1)
pasteCol = [A1].End(xlToRight).Column + 1
Cells(1, pasteCol).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Cells(1, pasteCol).EntireColumn.Delete
Cells(1, pasteCol).Select
nextCol = Selection.End(xlToRight).Column
Range(Cells(1, pasteCol), Cells(1, nextCol)).Select
For Each cell In Selection
cell.Value = cell.Value + structLen(i)
Next cell
Next j
Next i
wbNew.Activate
For i = 0 To nbStruct - 1
wsStruct(i).Select
Cells.NumberFormat = "@"
last = [A1].End(xlToRight).Column
If recLen = "" And Cells(4, last) = "FILLER" Then
Cells(1, last).EntireColumn.Delete
last = last - 1
End If
structLen(i) = Cells(1, last) + Cells(2, last)
Next i
wbNew.Activate
fileId = FreeFile
Open filePath For Binary Access Read As fileId
While Not EOF(fileId)
Get fileId, , bytes1
For i = 0 To nbStruct - 1
sData = ""
If condUti(i) = "D" Then
For j = condPos(i) To condPos(i) + condLen(i) - 1
sData = sData & convD(bytes1(j))
Next j
Else ' "3"
For j = condPos(i) To condPos(i) + condLen(i) - 1
sData = sData & conv3(bytes1(j))
Next j
End If
If sData = vals(i + 1) Then
Exit For
End If
Next i
If i < nbStruct Then
wsStruct(i).Select
If recLen <> "" Then
For j = 2 To [A1].End(xlToRight).Column
sData = ""
If Cells(3, j) = "D" Then
For k = Cells(1, j) To Cells(1, j) + Cells(2, j) - 1
sData = sData & convD(bytes1(k))
Next k
Else
If Cells(3, j) = "3" Then
For k = Cells(1, j) To Cells(1, j) + Cells(2, j) - 1
sData = sData & conv3(bytes1(k))
Next k
End If
End If
Cells(outRow(i), j) = sData
Next j
Else
ReDim bytes2(structLen(i) - minRead - 1) As Byte
Get fileId, , bytes2
For j = 2 To [A1].End(xlToRight).Column
sData = ""
If Cells(3, j) = "D" Then
For k = Cells(1, j) To Cells(1, j) + Cells(2, j) - 1
If k < minRead Then
sData = sData & convD(bytes1(k))
Else
sData = sData & convD(bytes2(k - minRead))
End If
Next k
Else
If Cells(3, j) = "3" Then
If k < minRead Then
sData = sData & conv3(bytes1(k))
Else
sData = sData & conv3(bytes2(k - minRead))
End If
End If
End If
Cells(outRow(i), j) = sData
Next j
End If
outRow(i) = outRow(i) + 1
End If
Wend |
