Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel transformer tableau word en excel avec modifs...

transformer tableau word en excel avec modifs...

8 réponses
Avatar
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=E9riodes (mois et ann=E9e) =E0 la suite sans retour =E0 la ligne=

s=E9par=E9s par une virgule ou autre, et en C1 les ann=E9es extr=E8mes du lo=
t.

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

Quelqu'un aurait-il une macro miracle ?
Merci
Signaler un problème avec ce contenu

8 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
d.sundow
Bonjour,

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

Sundow
Avatar
francois.forcet
On 5 mar, 15:09, jipeache wrote:
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 !!!!!

Avatar
isabelle
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


Avatar
francois.forcet
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
Avatar
jipeache
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

Avatar
isabelle
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



Avatar
isabelle
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




Avatar
jipeache
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