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.
Par simple curiosité, combien de feuilles word as-tu as traiter de la sorte en tout ?
Sundow
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 !!!!!
On 5 mar, 15:09, jipeache <jipea...@gmail.com> 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
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
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
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.
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
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
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
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
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
On 5 mar, 18:26, isabelle <i@v> 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
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
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
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
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
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
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 <i@v> 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
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
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
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 <i@v> 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
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