transformer tableau word en excel avec modifs...

Le
jipeache
bonjour,

J'ai plusieurs tableaux word de ce type :
http://cjoint.com/?dfpa1zp7p4

que je souhaite transformer :

dans excel (2003), obtenir un tableau simple avec en A1 la cote RV3/1,
en B1 les périodes (mois et année) à la suite sans retour à la ligne=

séparés par une virgule ou autre, et en C1 les années extrèmes du lo=
t.

Ex pour la 3eme ref du tableau :
en A1: RV 3/3, B1 : Janvier, mars - décembre 1904 ; Janvier-décembre
1905 ; Janvier-décembre 1906 ; Janvier-décembre 1907, C1 :1904-1907.

Quelqu'un aurait-il une macro miracle ?
Merci
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
d.sundow
Le #5235421
Bonjour,

Par simple curiosité, combien de feuilles word as-tu as traiter de la
sorte en tout ?

Sundow
francois.forcet
Le #5235251
On 5 mar, 15:09, jipeache
bonjour,

J'ai plusieurs tableaux word de ce type :http://cjoint.com/?dfpa1zp7p4

que je souhaite transformer :

dans excel (2003), obtenir un tableau simple avec en A1 la cote RV3/1,
en B1 les périodes (mois et année) à la suite sans retour à la lig ne
séparés par une virgule ou autre, et en C1 les années extrèmes du lot.

Ex pour la 3eme ref du tableau :
en A1: RV 3/3,  B1 : Janvier, mars - décembre 1904 ; Janvier-décembr e
1905 ; Janvier-décembre 1906 ; Janvier-décembre 1907, C1 :1904-1907.

Quelqu'un aurait-il une macro miracle ?
Merci


Salut à toi

Je te propose de tout ramener dans un fichier Excel et de traiter tes
données ensuite de cette application avec ce code :


Sheets("Feuil1").Cells.Clear
Dim oWdApp As Object
'Lancer Word
Set oWdApp = CreateObject("Word.Application")
With oWdApp
'Afficher Word si nécessaire...
.Visible = True
'Ouvrir le document Word
Set WordDoc = oWdApp.Documents.Open("C:CheminMon document.doc")
oWdApp.Selection.Find.ClearFormatting
With oWdApp.Selection.Find
.Text = "COTES"
End With
oWdApp.Selection.Find.Execute
oWdApp.Selection.SelectCurrentIndent
oWdApp.Selection.Copy
End With
Workbooks("Document.xls").Activate
Sheets("Feuil1").Activate
Range("A1").Activate
ActiveSheet.Paste
Cells.Select
With Selection
.MergeCells = False
End With
WordDoc.Close
oWdApp.Quit


Les instruction à adapter :

Sheets("Feuil1") est la feuille dans laquelle les données seront
raportées
C:CheminMon document.doc est le chemin et le nom de ton document
Word
"COTES" est le point de repère dans Word pour sélectionner le début du
tableau
Workbooks("Document.xls") est le document excel dans lequel on recopie
les données

Actualise en fonction de ta configuration celà devrait fonctionner

Dis moi !!!!!

isabelle
Le #5235181
bonjour ji,

une fois le tableau copier sur excel en Feuil1
je te propose la macro suivante pour la transformation du tableau (destination: Feuil2):

Sub Macro1()
With Sheets("Feuil1")
fin = .Range("C65536").End(xlUp).Row + 1
For i = 2 To fin
x = x + 1
Sheets("Feuil2").Range("A" & x) = .Range("A" & i)
LesMois = LesMois & .Range("B" & i) & .Range("C" & i) & ";"
LMin = .Range("C" & i)
For y = i + 1 To fin
If .Range("A" & y) = "" And y < fin Then
If .Range("B" & y) <> "" Then LesMois = LesMois & .Range("B" & y) & .Range("C" & y) & ";"
Else
LMax = .Range("C" & y - 1)
Sheets("Feuil2").Range("B" & x) = LesMois
Sheets("Feuil2").Range("C" & x) = LMin & "-" & Mid(LesMois, Len(LesMois) - 4, 4)
LesMois = ""
Exit For
End If
i = y
Next
Next
End With
Sheets("Feuil2").Range("B:B").ColumnWidth = 50
Sheets("Feuil2").Range("B:B").Rows.AutoFit
End Sub

isabelle

bonjour,

J'ai plusieurs tableaux word de ce type :
http://cjoint.com/?dfpa1zp7p4

que je souhaite transformer :

dans excel (2003), obtenir un tableau simple avec en A1 la cote RV3/1,
en B1 les périodes (mois et année) à la suite sans retour à la ligne
séparés par une virgule ou autre, et en C1 les années extrèmes du lot.

Ex pour la 3eme ref du tableau :
en A1: RV 3/3, B1 : Janvier, mars - décembre 1904 ; Janvier-décembre
1905 ; Janvier-décembre 1906 ; Janvier-décembre 1907, C1 :1904-1907.

Quelqu'un aurait-il une macro miracle ?
Merci


francois.forcet
Le #5235151
Rebonjours à toi
Un petit oubli que je m'empresse de combler :
Il faut activer la référence : Microsoft Word Object Library dans
Outils/Références pour que la macro fonctionne
Mille excuses
jipeache
Le #5234671
On 5 mar, 18:26, isabelle wrote:
bonjour ji,

une fois le tableau copier sur excel en Feuil1
je te propose la macro suivante pour la transformation du tableau (destina tion: Feuil2):

Sub Macro1()
With Sheets("Feuil1")
fin = .Range("C65536").End(xlUp).Row + 1
For i = 2 To fin
x = x + 1
Sheets("Feuil2").Range("A" & x) = .Range("A" & i)
LesMois = LesMois & .Range("B" & i) & .Range("C" & i) & ";"
LMin = .Range("C" & i)
For y = i + 1 To fin
If .Range("A" & y) = "" And y < fin Then
If .Range("B" & y) <> "" Then LesMois = LesMois & .Range("B" & y) & .Range("C" & y) & ";"
Else
LMax = .Range("C" & y - 1)
Sheets("Feuil2").Range("B" & x) = LesMois
Sheets("Feuil2").Range("C" & x) = LMin & "-" & Mid(LesMois, Len(L esMois) - 4, 4)
LesMois = ""
Exit For
End If
i = y
Next
Next
End With
Sheets("Feuil2").Range("B:B").ColumnWidth = 50
Sheets("Feuil2").Range("B:B").Rows.AutoFit
End Sub

isabelle

Merci beaucoup, cela fonctionne bien à priori.

2 petits détails :
l'année est collée au dernier mois, possible d'insérer un espace
avant ?
il y a un ";" à la fin de chaque ligne de dates (en B), possible de
l'éviter ? sinon j'utiliserai autre chose pour le ";"
Merci encore

isabelle
Le #5234411
bonjour ji,

dit moi si ça va ?

Sub Macro1()
With Sheets("Feuil1")
fin = .Range("C65536").End(xlUp).Row + 1
For i = 2 To fin
x = x + 1
Sheets("Feuil2").Range("A" & x) = .Range("A" & i)
LesMois = LesMois & .Range("B" & i) & .Range("C" & i) & ";"
LMin = .Range("C" & i)
For y = i + 1 To fin
If .Range("A" & y) = "" And y < fin Then
If .Range("B" & y) <> "" Then LesMois = LesMois & .Range("B" & y) & " " & .Range("C" & y) & ";"
Else
LMax = .Range("C" & y - 1)
Sheets("Feuil2").Range("B" & x) = Mid(LesMois, 1, Len(LesMois) - 1)
Sheets("Feuil2").Range("C" & x) = LMin & "-" & Mid(LesMois, Len(LesMois) - 4, 4)
LesMois = ""
Exit For
End If
i = y
Next
Next
End With
Sheets("Feuil2").Range("B:B").ColumnWidth = 50
Sheets("Feuil2").Range("B:B").Rows.AutoFit
End Sub

isabelle



Merci beaucoup, cela fonctionne bien à priori.
2 petits détails :
l'année est collée au dernier mois, possible d'insérer un espace
avant ?
il y a un ";" à la fin de chaque ligne de dates (en B), possible de
l'éviter ? sinon j'utiliserai autre chose pour le ";"
Merci encore



isabelle
Le #5234391
correction :

Sub Macro1()
With Sheets("Feuil1")
fin = .Range("C65536").End(xlUp).Row + 1
For i = 2 To fin
x = x + 1
Sheets("Feuil2").Range("A" & x) = .Range("A" & i)
LesMois = LesMois & .Range("B" & i) & " " & .Range("C" & i) & ";"
LMin = .Range("C" & i)
For y = i + 1 To fin
If .Range("A" & y) = "" And y < fin Then
If .Range("B" & y) <> "" Then LesMois = LesMois & .Range("B" & y) & " " & .Range("C" & y) & ";"
Else
LMax = .Range("C" & y - 1)
Sheets("Feuil2").Range("B" & x) = Mid(LesMois, 1, Len(LesMois) - 1)
Sheets("Feuil2").Range("C" & x) = LMin & "-" & Mid(LesMois, Len(LesMois) - 4, 4)
LesMois = ""
Exit For
End If
i = y
Next
Next
End With
Sheets("Feuil2").Range("B:B").ColumnWidth = 50
Sheets("Feuil2").Range("B:B").Rows.AutoFit
End Sub

isabelle

On 5 mar, 18:26, isabelle wrote:
bonjour ji,

une fois le tableau copier sur excel en Feuil1
je te propose la macro suivante pour la transformation du tableau (destination: Feuil2):

Sub Macro1()
With Sheets("Feuil1")
fin = .Range("C65536").End(xlUp).Row + 1
For i = 2 To fin
x = x + 1
Sheets("Feuil2").Range("A" & x) = .Range("A" & i)
LesMois = LesMois & .Range("B" & i) & .Range("C" & i) & ";"
LMin = .Range("C" & i)
For y = i + 1 To fin
If .Range("A" & y) = "" And y < fin Then
If .Range("B" & y) <> "" Then LesMois = LesMois & .Range("B" & y) & .Range("C" & y) & ";"
Else
LMax = .Range("C" & y - 1)
Sheets("Feuil2").Range("B" & x) = LesMois
Sheets("Feuil2").Range("C" & x) = LMin & "-" & Mid(LesMois, Len(LesMois) - 4, 4)
LesMois = ""
Exit For
End If
i = y
Next
Next
End With
Sheets("Feuil2").Range("B:B").ColumnWidth = 50
Sheets("Feuil2").Range("B:B").Rows.AutoFit
End Sub

isabelle

Merci beaucoup, cela fonctionne bien à priori.

2 petits détails :
l'année est collée au dernier mois, possible d'insérer un espace
avant ?
il y a un ";" à la fin de chaque ligne de dates (en B), possible de
l'éviter ? sinon j'utiliserai autre chose pour le ";"
Merci encore




jipeache
Le #5233661
Sub Macro1()
With Sheets("Feuil1")
fin = .Range("C65536").End(xlUp).Row + 1
For i = 2 To fin
x = x + 1
Sheets("Feuil2").Range("A" & x) = .Range("A" & i)
LesMois = LesMois & .Range("B" & i) & " " & .Range("C" & i) & ";"
LMin = .Range("C" & i)
For y = i + 1 To fin
If .Range("A" & y) = "" And y < fin Then
If .Range("B" & y) <> "" Then LesMois = LesMois & .Range("B" & y) & " " & .Range("C" & y) & ";"
Else
LMax = .Range("C" & y - 1)
Sheets("Feuil2").Range("B" & x) = Mid(LesMois, 1, Len(LesMois) - 1)
Sheets("Feuil2").Range("C" & x) = LMin & "-" & Mid(LesMois, Len(L esMois) - 4, 4)
LesMois = ""
Exit For
End If
i = y
Next
Next
End With
Sheets("Feuil2").Range("B:B").ColumnWidth = 50
Sheets("Feuil2").Range("B:B").Rows.AutoFit
End Sub

isabelle


On 5 mar, 18:26, isabelle wrote:
bonjour ji,

une fois le tableau copier sur excel en Feuil1
je te propose la macro suivante pour la transformation du tableau (dest ination: Feuil2):

Sub Macro1()
With Sheets("Feuil1")
fin = .Range("C65536").End(xlUp).Row + 1
For i = 2 To fin
x = x + 1
Sheets("Feuil2").Range("A" & x) = .Range("A" & i)
LesMois = LesMois & .Range("B" & i) & .Range("C" & i) & ";"
LMin = .Range("C" & i)
For y = i + 1 To fin
If .Range("A" & y) = "" And y < fin Then
If .Range("B" & y) <> "" Then LesMois = LesMois & .Range("B" & y) & .Range("C" & y) & ";"
Else
LMax = .Range("C" & y - 1)
Sheets("Feuil2").Range("B" & x) = LesMois
Sheets("Feuil2").Range("C" & x) = LMin & "-" & Mid(LesMois, Le n(LesMois) - 4, 4)
LesMois = ""
Exit For
End If
i = y
Next
Next
End With
Sheets("Feuil2").Range("B:B").ColumnWidth = 50
Sheets("Feuil2").Range("B:B").Rows.AutoFit
End Sub

isabelle




Bonjour,
J'ai fait 2, 3 tests sur petits fichiers, cela semble parfait.
Bravo et merci beaucoup, je me voyais mal parti avec tous ces fichiers
word à remanier.
Merci encore
JP





Publicité
Poster une réponse
Anonyme