Péhemme
2013-09-16 17:56:52 UTC
Bonjour à Tous,
Dans le cadre d'une association, je souhaite automatiser la présentation
d'une liste de participants.
Cette liste est issue (en C5) d'un copier-coller (à la main) des
destinataires d'un courriel.
Afin de "travailler" le résultat de ce copier-coller, j'ai écrit la macro
suivante qui fonctionne (si des puristes trouvent à la simplifier, ils
seront les bienvenus).
Ma question concerne le tableau de tableaux à passer à la méthode
FieldInfo:= du TextToColumns.
Comment automatiser cette information afin de l'adapter à une liste
évolutive (mon exemple comporte 20 participants, mais ce nombre peut être
variable) ?
À la lecture de l'aide, j'ai bien compris que le premier argument était le
n° de ma colonne de mon tableau et le second 1 du type général.
Mais comment l'automatiser ?
Une boucle sur les colonnes ? Mais je ne vois pas comment l'écrire pour
restituer le tableau final.
Sub ListeDesParticipants()
Dim DerCol As Integer
Dim DerLin As Long
With Application
.ScreenUpdating = False
.CutCopyMode = False
End With
Range("C5").TextToColumns _
Destination:=Range("C10"), _
DataType:=xlDelimited, _
Tab:=False, _
Semicolon:=True, _
Comma:=False, _
Space:=False, _
Other:=False, _
FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1),
Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10,
1), _
Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1),
Array(15, 1), _
Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),
Array(20, 1), _
Array(21, 1))
DerCol = Cells(10, Columns.Count).End(xlToLeft).Column
Range(Cells(10, 3), Cells(10, DerCol)).Copy
Range("C15").PasteSpecial _
Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Selection.TextToColumns _
Destination:=Range("F15"), _
DataType:=xlDelimited, _
Other:=True, OtherChar:="<", _
FieldInfo:= _
Array(Array(1, 1), Array(2, 1))
DerLin = Range("G" & Rows.Count).End(xlUp).Row
Range("G15:G" & DerLin).Replace _
What:=">", Replacement:=""
Range("F15:F" & DerLin).Cut Range("C15")
Application.CutCopyMode = False
Range("C15:C" & DerLin).TextToColumns _
Destination:=Range("C15"), _
DataType:=xlDelimited, _
Space:=True, _
FieldInfo:= _
Array(Array(1, 1), Array(2, 1))
With Application
.ScreenUpdating = True
End With
End Sub
Merci d'avance de votre aide.
Michel
Dans le cadre d'une association, je souhaite automatiser la présentation
d'une liste de participants.
Cette liste est issue (en C5) d'un copier-coller (à la main) des
destinataires d'un courriel.
Afin de "travailler" le résultat de ce copier-coller, j'ai écrit la macro
suivante qui fonctionne (si des puristes trouvent à la simplifier, ils
seront les bienvenus).
Ma question concerne le tableau de tableaux à passer à la méthode
FieldInfo:= du TextToColumns.
Comment automatiser cette information afin de l'adapter à une liste
évolutive (mon exemple comporte 20 participants, mais ce nombre peut être
variable) ?
À la lecture de l'aide, j'ai bien compris que le premier argument était le
n° de ma colonne de mon tableau et le second 1 du type général.
Mais comment l'automatiser ?
Une boucle sur les colonnes ? Mais je ne vois pas comment l'écrire pour
restituer le tableau final.
Sub ListeDesParticipants()
Dim DerCol As Integer
Dim DerLin As Long
With Application
.ScreenUpdating = False
.CutCopyMode = False
End With
Range("C5").TextToColumns _
Destination:=Range("C10"), _
DataType:=xlDelimited, _
Tab:=False, _
Semicolon:=True, _
Comma:=False, _
Space:=False, _
Other:=False, _
FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1),
Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10,
1), _
Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1),
Array(15, 1), _
Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1),
Array(20, 1), _
Array(21, 1))
DerCol = Cells(10, Columns.Count).End(xlToLeft).Column
Range(Cells(10, 3), Cells(10, DerCol)).Copy
Range("C15").PasteSpecial _
Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Selection.TextToColumns _
Destination:=Range("F15"), _
DataType:=xlDelimited, _
Other:=True, OtherChar:="<", _
FieldInfo:= _
Array(Array(1, 1), Array(2, 1))
DerLin = Range("G" & Rows.Count).End(xlUp).Row
Range("G15:G" & DerLin).Replace _
What:=">", Replacement:=""
Range("F15:F" & DerLin).Cut Range("C15")
Application.CutCopyMode = False
Range("C15:C" & DerLin).TextToColumns _
Destination:=Range("C15"), _
DataType:=xlDelimited, _
Space:=True, _
FieldInfo:= _
Array(Array(1, 1), Array(2, 1))
With Application
.ScreenUpdating = True
End With
End Sub
Merci d'avance de votre aide.
Michel