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
|
Option Explicit
Dim TblLgns, TblMots(), Tbl2d()
Dim fso, fichier, T, U, V, D2max
Dim ContenuFichier, TblCol
Dim ChemNomFichier
Dim chaine
Dim oFich2
Dim i
Dim w
Dim n1
Dim n
Dim strSearchFor
Dim z
Dim m
Dim o
Sub ConstruitTableau2D()
strSearchFor = "ODP3"
ChemNomFichier = "C:\Script_vbs\1.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fichier = fso.opentextfile(ChemNomFichier, 1)
ContenuFichier = fichier.ReadAll
fichier.Close
Set fichier = Nothing
Set fso = Nothing
D2max = 1 'pour trouver la ligne qui a le plus de mots (colonnes)
TblLgns = Split(ContenuFichier,vbNewline) 'on recupère le tableau de lignes
MsgBox Ubound(TblLgns)
For i = 1 To Ubound(TblLgns)
n1 = TblLgns(i)
If InStr(1, n1, strSearchFor,vbTextCompare) <> 0 then
MsgBox i
Exit For
End If
Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set fichier = fso.opentextfile(ChemNomFichier, 1)
ContenuFichier = fichier.ReadAll
fichier.Close
Set fichier = Nothing
Set fso = Nothing
D2max = 1 'pour trouver la ligne qui a le plus de mots (colonnes)
TblLgns = Split(ContenuFichier,vbNewline) 'on recupère le tableau de lignes
For T = 0 To UBound(TblLgns)
TblCol = Split(TblLgns(T), " ", -1, 1)
If D2max < UBound(TblCol) Then D2max = UBound(TblCol)
Next
'maintenant que l'on a les 2 dimensions du tableau ...
Redim Tbl2d(UBound(TblLgns), D2max)' on le dimensionne
V=0 'pour incrémenter/dimensionner le tableau des mots
For T = 0 To UBound(TblLgns)
TblCol = Split(TblLgns(T), " ", -1, vbTextCompare)' on optient chaque mots de la ligne
For U = 0 To UBound(TblCol)' on boucle pour ....
Tbl2d(T,U)= TblCol(U) 'remplissage du tableau 2D
Redim Preserve TblMots(V)'on dimensionne au fur et a mesure le tableau de mots
TblMots(V) = TblCol(U) 'remplissage du tableau de mots
V=V+1
Next
Next
'Coller le resultat avec la bonne mise en forme
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFich2=fso.OpenTextFile("C:\Script_vbs\vide.txt",2,True)
'Calcul pour que ce soit aligné
For w = i to Ubound(Tbl2d)
'w = w + 28
If Tbl2D (w,11) <> "" Then
If Tbl2D(w,52)<> "" Then z = 11
ElseIf Tbl2D(w,51) <> "" Then o = 10
ElseIf Tbl2D(w,50) <> "" Then o = 9
ElseIf Tbl2D(w,49) <> "" Then o = 8
ElseIf Tbl2D(w,48) <> "" Then o = 7
ElseIf Tbl2D(w,47) <> "" Then o = 6
ElseIf Tbl2D(w,46) <> "" Then o = 5
End If
If Tbl2d(w,34) <> "" Then
m = Len(Tbl2d(w,29)& Tbl2d(w,30) & Tbl2d(w,31) & Tbl2d(w,32) & Tbl2d(w,33) & Tbl2d(w,34))
n = 46-m
oFich2.Write Tbl2d(w,0) & vbTab & Tbl2d(w,11) & " " & Tbl2d(w,22) & " " &Tbl2d(w,23) & " " & Tbl2d(w,24) & Tbl2d(w,25) & Tbl2d(w,26) & Tbl2d(w,29) & Tbl2d(w,30) & Tbl2d(w,31) & Tbl2d(w,32) & Tbl2d(w,33) & Tbl2d(w,34) & Space(n) & Tbl2d(w,29 + n ) & Space(o) & Tbl2d(w,29 + n + o) & vbTab & Tbl2d(w,63)
oFich2.Write vbNewline
ElseIf Tbl2d(w,33) <> "" Then
m = Len(Tbl2d(w,29)& Tbl2d(w,30) & Tbl2d(w,31) & Tbl2d(w,32) & Tbl2d(w,33))
n = 46-m
oFich2.Write Tbl2d(w,0) & vbTab & Tbl2d(w,11) & " " & Tbl2d(w,22) & " " &Tbl2d(w,23) & " " & Tbl2d(w,24) & Tbl2d(w,25) & Tbl2d(w,26) & Tbl2d(w,29) & Tbl2d(w,30) & Tbl2d(w,31) & Tbl2d(w,32) & Tbl2d(w,33) & Space(n) & Tbl2d(w,29 + n ) & Space(o) & Tbl2d(w,29 + n + o) & vbTab & Tbl2d(w,63)
oFich2.Write vbNewline
ElseIf Tbl2d(w,32) <> "" Then
m = Len(Tbl2d(w,29)& Tbl2d(w,30) & Tbl2d(w,31) & Tbl2d(w,32))
n = 46-m
oFich2.Write Tbl2d(w,0) & vbTab & Tbl2d(w,11) & " " & Tbl2d(w,22) & " " &Tbl2d(w,23) & " " & Tbl2d(w,24) & Tbl2d(w,25) & Tbl2d(w,26) & Tbl2d(w,29) & Tbl2d(w,30) & Tbl2d(w,31) & Tbl2d(w,32) & Space(n) & Tbl2d(w,29 + n ) & Space(o) & Tbl2d(w,29 + n + o) & vbTab & Tbl2d(w,63)
oFich2.Write vbNewline
ElseIf Tbl2d(w,31) <> "" Then
m = Len(Tbl2d(w,29)& Tbl2d(w,30) & Tbl2d(w,31))
n = 46-m
oFich2.Write Tbl2d(w,0) & vbTab & Tbl2d(w,11) & " " & Tbl2d(w,22) & " " &Tbl2d(w,23) & " " & Tbl2d(w,24) & Tbl2d(w,25) & Tbl2d(w,26) & Tbl2d(w,29) & Tbl2d(w,30) & Tbl2d(w,31) & Space(n) & Tbl2d(w,29 + n ) & Space(o) & Tbl2d(w,29 + n + o) & vbTab & Tbl2d(w,63)
oFich2.Write vbNewline
ElseIf Tbl2d(w,30) <> "" Then
m = Len(Tbl2d(w,29)& Tbl2d(w,30))
n = 46-m
oFich2.Write Tbl2d(w,0) & vbTab & Tbl2d(w,11) & " " & Tbl2d(w,22) & " " &Tbl2d(w,23) & " " & Tbl2d(w,24) & Tbl2d(w,25) & Tbl2d(w,26) & Tbl2d(w,29) & Tbl2d(w,30) & Space(n) & Tbl2d(w,29 + n ) & Space(o) & Tbl2d(w,29 + n + o) & vbTab & Tbl2d(w,63)
oFich2.Write vbNewline
Else
m = Len(Tbl2D(w,29))
n = 46 - m
oFich2.Write Tbl2d(w,0) & vbTab & Tbl2d(w,11) & " " & Tbl2d(w,22) & " " &Tbl2d(w,23) & " " & Tbl2d(w,24) & Tbl2d(w,25) & Tbl2d(w,26) & Tbl2d(w,29) & Space(n) & Tbl2d(w,29 + n ) & Space(o) & Tbl2d(w,29 + n + o) & vbTab & Tbl2d(w,63)
oFich2.Write vbNewline
End If
Else
If Tbl2D(w,53)<> "" Then z = 5
ElseIf Tbl2D(w,54) <> "" Then o = 6
ElseIf Tbl2D(w,55) <> "" Then o = 7
ElseIf Tbl2D(w,56) <> "" Then o = 8
ElseIf Tbl2D(w,57) <> "" Then o = 9
ElseIf Tbl2D(w,58) <> "" Then o = 10
ElseIf Tbl2D(w,59) <> "" Then o = 11
End If
If Tbl2D(w,41)<> "" Then
m = Len(Tbl2d(w,36)& Tbl2d(w,37) & Tbl2d(w,38) & Tbl2d(w,39) & Tbl2d(w,40) & Tbl2d(w,41))
n = 38-m
oFich2.Write Tbl2d(w,0) & vbTab & " " & Tbl2d(w,29) & " " &Tbl2d(w,30) & " " & Tbl2d(w,31) & Tbl2d(w,32) & Tbl2d(w,33) & Tbl2d(w,36) & Tbl2d(w,37) & Tbl2d(w,38) & Tbl2d(w,39) & Tbl2d(w,40) & Tbl2d(w,41) & Space(n) & Tbl2d(w,36 + n ) & Space(o) & Tbl2d(w,36 + n + o) & vbTab & Tbl2d(w,70)
oFich2.Write vbNewline
ElseIf Tbl2D(w,40) <> "" Then
m = Len(Tbl2d(w,36)& Tbl2d(w,37) & Tbl2d(w,38) & Tbl2d(w,39) & Tbl2d(w,40))
n = 38-m
oFich2.Write Tbl2d(w,0) & vbTab & " " & Tbl2d(w,29) & " " &Tbl2d(w,30) & " " & Tbl2d(w,31) & Tbl2d(w,32) & Tbl2d(w,33) & Tbl2d(w,36) & Tbl2d(w,37) & Tbl2d(w,38) & Tbl2d(w,39) & Tbl2d(w,40) & Space(n) & Tbl2d(w,36 + n ) & Space(o) & Tbl2d(w,36 + n + o) & vbTab & Tbl2d(w,70)
oFich2.Write vbNewline
ElseIf Tbl2D(w,39) <> "" Then
m = Len(Tbl2d(w,36)& Tbl2d(w,37) & Tbl2d(w,38) & Tbl2d(w,39))
n = 38-m
oFich2.Write Tbl2d(w,0) & vbTab & " " & Tbl2d(w,29) & " " &Tbl2d(w,30) & " " & Tbl2d(w,31) & Tbl2d(w,32) & Tbl2d(w,33) & Tbl2d(w,36) & Tbl2d(w,37) & Tbl2d(w,38) & Tbl2d(w,39) & Space(n) & Tbl2d(w,36 + n ) & Space(o) & Tbl2d(w,36 + n + o) & vbTab & Tbl2d(w,70)
oFich2.Write vbNewline
ElseIf Tbl2D(w,38) <> "" Then
m = Len(Tbl2d(w,36)& Tbl2d(w,37) & Tbl2d(w,38))
n = 38-m
oFich2.Write Tbl2d(w,0) & vbTab & " " & Tbl2d(w,29) & " " &Tbl2d(w,30) & " " & Tbl2d(w,31) & Tbl2d(w,32) & Tbl2d(w,33) & Tbl2d(w,36) & Tbl2d(w,37) & Tbl2d(w,38) & Space(n) & Tbl2d(w,36 + n ) & Space(o) & Tbl2d(w,36 + n + o) & vbTab & Tbl2d(w,70)
oFich2.Write vbNewline
'MsgBox n
' MsgBox m
'MsgBox Tbl2D(w, 36 + n)
'MSgBox Tbl2D(w,z)
ElseIf Tbl2D(w,37) <> "" Then
m = Len(Tbl2d(w,36)& Tbl2d(w,37))
n = 38-m
oFich2.Write Tbl2d(w,0) & vbTab & " " & Tbl2d(w,29) & " " &Tbl2d(w,30) & " " & Tbl2d(w,31) & Tbl2d(w,32) & Tbl2d(w,33) & Tbl2d(w,36) & Tbl2d(w,37) & Space(n) & Tbl2d(w,36 + n ) & Space(o) & Tbl2d(w,36+n+o) & vbTab & Tbl2d(w,70)
oFich2.Write vbNewline
ElseIf Tbl2D (w,36) <> "" Then
m = Len(Tbl2d(w,36))
n = 38-m
oFich2.Write Tbl2d(w,0) & vbTab & " " & Tbl2d(w,29) & " " &Tbl2d(w,30) & " " & Tbl2d(w,31) & Tbl2d(w,32) & Tbl2d(w,33) & Tbl2d(w,36) & Space(n) & Tbl2d(w,36 + n ) & Space(o) & Tbl2d(w,36 + n + o) & vbTab & Tbl2d(w,70)
oFich2.Write vbNewline
End If
End If
Next
' Nettoyage des variables a la fin
Set oFich2 = Nothing
Set fso = Nothing
End Sub
Call ConstruitTableau2D |
Erreur Next manquant incomprise
Répondre avec citation
Partager