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 |
Partager