C'est la même macro que l'autre, sauf que le résultat s'affiche dans les
mêmes colonnes que la plage originale, mais juste en dessous en laissant une
ligne vide entre les 2 plages de cellules.
En passant, n'oublie pas de définir dans cette variable la longueur de la
chaîne de caractères à retenir pour chacune des colonnes dans cette
expression :
'Longueur pour chacune des colonnes
Arr = Array(2, 5, 6, 8, 1, 8, 3) 'Ce sont des valeurs fictives...
'----------------------------------------------------------------------------
Sub Test1()
Dim A As Long
'Représentant la plage de cellules
Dim Rg As Range 'représentant la plage de cellules
Dim C As Range, R As Range, Cel As Range, Rg1 As Range
Dim L As Long 'Variable représentant la longueur
'de la chaîne de caractères que tu veux obtenir
'dans la colonne.
Dim Arr() 'Variable tableau représentant la longueur
'de chacune des colonnes en partant de la colonne la
'plus à gauche vers la droite
'Longueur pour chacune des colonnes
Arr = Array(2, 5, 6, 8, 1, 8, 3)
Application.EnableEvents = True
Application.ScreenUpdating = True
With Worksheets("Feuil1") 'Nom à déterminer
'Définis la plage de cellules.
Set Rg = .Range("C7:I16") 'à déterminer
End With
'Traitement pour chaque colonne de la plage
For Each C In Rg.Columns
'A sert à titre de compteur
L = Arr(A)
'Transformation du contenu de la colonne selon la longueur retenue
C.TextToColumns Destination:=C.Cells(Rg.Rows.Count + 2, 1),
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(Arr(A), 9)),
TrailingMinusNumbers:=True
A = A + 1
Next
Set Rg1 = Rg.Offset(Rg.Rows.Count + 1)
'pour concaténer le texte de chacune des cellules vers la cellule
'à droite de la dernière cellule occupée de la plage.
A = 0
For Each R In Rg1.Rows
Erase Arr
For Each C In R.Columns
For Each Cel In C
A = A + 1
ReDim Preserve Arr(1 To A)
Arr(A) = Cel.Value
Next
Next
'Dans cette ligne de code, tu peux remplacer "" en
'Insérant un séparateur de ton choix comme espace " ".
Rg1(R.Row, 1).Offset(, Rg1.Columns.Count) = Trim(Join(Arr, ""))
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'----------------------------------------------------------------------------
MichD
"MichD" a écrit dans le message de groupe de discussion :
orq9gm$80b$***@gioia.aioe.org...
Bonjour,
J'ai créé une macro qui fait ce que tu veux...
Tu dois renseigner 2 valeurs :
A )
Nom de la feuille dans l'expression : With Worksheets("Feuil1")
B )
Spécifier l'étendue de ta plage de cellule dans :
Set Rg = .Range("A1:G10") 'à déterminer
La macro fait :
De la colonne A à G, elle remplace le contenu des cellules seulement
avec le nombre de caractères que tu veux retenir pour chacune des colonnes.
Au besoin, j'aurais pu choisir une autre plage de cellules ou sur une autre
feuille pour inscrire le résultat.
Dans la colonne H, pour chacune des lignes, tu obtiens la concaténation
pour toutes les cellules de chacune des lignes. Au besoin du peux insérer
un "séparateur" entre chacune des valeurs dans cette ligne de code
Rg(R.Row, 1).Offset(, Rg.Columns.Count) = Trim(Join(Arr, ""))
'-------------------------------------------------------------
Sub Test()
Dim A As Long
'Représentant la plage de cellules
Dim Rg As Range 'représentant la plage de cellules
Dim C As Range, R As Range, Cel As Range
Dim L As Long 'Variable représentant la longueur
'de la chaîne de caractères que tu veux obtenir
'dans la colonne.
Dim Arr() 'Variable tableau représentant la longueur
'de chacune des colonnes en partant de la colonne la
'plus à gauche vers la droite
'Longueur pour chacune des colonnes
Arr = Array(2, 5, 6, 8, 1, 8, 3)
Application.EnableEvents = True
Application.ScreenUpdating = True
With Worksheets("Feuil1") 'Nom à déterminer
'Définis la plage de cellules.
Set Rg = .Range("A1:G10") 'à déterminer
End With
'Traitement pour chaque colonne de la plage
For Each C In Rg.Columns
'A sert à titre de compteur
L = Arr(A)
'Transformation du contenu de la colonne selon la longueur retenue
C.TextToColumns Destination:=C, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(Arr(A), 9)),
TrailingMinusNumbers:=True
A = A + 1
Next
'Pour concaténer le texte de chacune des cellules vers la cellule
'à droite de la dernière cellule occupée de la plage.
A = 0
For Each R In Rg.Rows
Erase Arr
For Each C In R.Columns
For Each Cel In C
A = A + 1
ReDim Preserve Arr(1 To A)
Arr(A) = Cel.Value
Next
Next
'dans cette ligne de code, tu peux remplacer "" en
'Insérant un séparateur de ton choix comme espace " ".
Rg(R.Row, 1).Offset(, Rg.Columns.Count) = Trim(Join(Arr, ""))
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'-------------------------------------------------------------
MichD