dé-concaténation de colonnes

Version imprimable

26/03/2012, 17h58
SylvainM

dé-concaténation de colonnes
Bonjour à tous,

Je dispose de tableaux dans lesquels je dois très fréquemment "dé-concaténer" une colonne en 3 autres colonnes.
Voici un exemple.
A partir de :
Code:

1 2 3 Code P18A27Ph12 P01A02Ph01
Je dois obtenir 3 colonnes
Code:

1 2 3 P A Ph Code P18 A27 Ph12 P18A27Ph12 P01 A02 Ph01 P01A02Ph01
Les formules pour y parvenir sont basiques, à coup de GAUCHE() et STXT().
Mais comme je fais ça très souvent, je voudrai créer une macro qui le fasse.

Malheureusement, je suis pas doué en VBA (euphémisme :aie:) et je ne sais pas du tout comment :
- insérer des colonnes avant une colonne spécifique, identifiée par le nom de champ de cette colonne (1ere ligne du tableau)
- remplir ces colonnes par une fonction, sauf pour la 1ère ligne où il doit être noté le nom du champ ("P" "A" "Ph")

Y aurait-il quelqu'un pour m'aider ?

Merci d'avance !

Sylvain M.

Bonsoir,

Pour dé-concatener les chaînes de caractères en 3 colonnes, à partir de valeur se trouvant dans la colonne A à partir de la 2ème ligne,
de la première feuille du classeur :

Code:

1
2
3
4
5
6
7
8
9
10
11
    Dim r As Range
    Dim v As String
    With Worksheets(1)  'première feuille du classeur
        For Each r In .Range("A2:A" & .Range("A2").End(xlDown).Row)
            v = r.Value
            r.Value = Mid(v, 1, 3)
            r.Offset(0, 1).Value = Mid(v, 4, 3)
            r.Offset(0, 2).Value = Mid(v, 7)
            r.Offset(0, 3) = v
        Next r
    End With

Si tu as toujours les données en colonne A que tu veux scinder 3 lettres par 3

Code:

1
2
3
4
5
6
7
8
Sub Conv()
Dim LastLig As Long
 
With Worksheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("A2:A" & LastLig).TextToColumns Destination:=.Range("A2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(3, 1), Array(6, 1)), TrailingMinusNumbers:=True
End With
End Sub

27/03/2012, 10h51
SylvainM

Merci beaucoup de vous être penchés sur mon problème !

Bon, comme je ne comprends pas grand chose aux codes proposés, je ne sais lequel choisir... Alors, je vais essayer de me pencher sur la 1ere proposition (désolé Mercatog ;) ).

Alors, déjà je pense que je peux remplacer

Code:

With Worksheets("Feuil1")

par

Code:

With Worksheets(ActiveSheet.Name)

Pour sélectionner la feuille active.

Maintenant, ma colonne de codes n'est pas forcément en colonne A. Et ça me ferait gagner du temps de ne pas avoir à la déplacer à chaque fois. J'aimerai bien que la macro détecte la colonne sélectionnée.
Un truc du genre ActiveCell.colomn ??

Enfin, dernière question, comment faire pour nommer les premières lignes des colonnes créées avec un nom défini ??

Encore merci pour votre aide !

Sylvain M.

Bonjour,

Si le but est d'utiliser la feuille active With ActiveSheet, ou même rien du tout est suffisant.
(il faut juste retirer les . devant les Range.

Ce qui peut donner ça, par exemple :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
  Dim r As Range
  Dim v As String
  With ActiveCell
    Cells(1, .Column).Value = "P"
    Cells(1, .Column + 1).Value = "A"
    Cells(1, .Column + 2).Value = "Ph"
    Cells(1, .Column + 3).Value = "Code"
 
    For Each r In Range(Cells(.Row, .Column), Cells(Cells(.Row, .Column).End(xlDown).Row, .Column))
        v = r.Value
        r.Value = Mid(v, 1, 3)
        r.Offset(0, 1).Value = Mid(v, 4, 3)
        r.Offset(0, 2).Value = Mid(v, 7)
        r.Offset(0, 3) = v
    Next r
 End With

ou bien en adaptant le code de Mercatog :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Conv()
 
    Dim LastLig As Long
 
    With ActiveCell
        Cells(1, .Column).Value = "P"
        Cells(1, .Column + 1).Value = "A"
        Cells(1, .Column + 2).Value = "Ph"
        Cells(1, .Column + 3).Value = "Code"
 
        LastLig = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
        Range(Cells(.Row, .Column), Cells(LastLig, .Column)).Copy
        Range(Cells(.Row, .Column + 3), Cells(LastLig, .Column + 3)).PasteSpecial xlPasteAll
        Range(Cells(.Row, .Column), Cells(LastLig, .Column)).TextToColumns Destination:=Cells(.Row, .Column), _
                DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(3, 1), Array(6, 1)), TrailingMinusNumbers:=True
        Cells(.Row, .Column).Select
 
    End With
End Sub

27/03/2012, 15h45
SylvainM

Merci encore !

Je viens d'essayer les 2 codes et je rencontre 2 problèmes identiques :
- les colonnes situées à droite de ma colonne de code sont perdues (remplacées par le résultat de la "dé-concaténation" )
- les premières lignes (noms de champs) ne sont pas renommées comme semble pourtant le faire la macro ("P" / "A" / "Ph" / "Code"). J'ai l'impression (mais je peux me tromper), que c'est la 2eme moitié du code qui efface les valeurs ?

J'ai beau chercher par moi-même, j'avoue que la correction de ces problèmes m'est encore inabordable !

Une idée ?

Sylvain M.

Bonsoir,

Les 2 codes fond effectivement la même chose.

Je trouvais peu pratique d'insérer des colonnes à chaque exécution de macro. Je ne l'avais donc pas codé.

Le code ci-dessous doit corrigé les problèmes soulevés.
Avant de l'exécuter, il faut sélectionner la première cellule contenant une valeur à décoder.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
   Dim r As Range
  Dim v As String
  With ActiveCell
    Call ActiveSheet.Columns(.Column).EntireColumn.Insert(False, True)
    Call ActiveSheet.Columns(.Column).EntireColumn.Insert(False, True)
    Call ActiveSheet.Columns(.Column).EntireColumn.Insert(False, True)
    ActiveSheet.Cells(1, .Column - 3).Value = "P"
    ActiveSheet.Cells(1, .Column - 2).Value = "A"
    ActiveSheet.Cells(1, .Column - 1).Value = "Ph"
    ActiveSheet.Cells(1, .Column).Value = "Code"
 
    For Each r In ActiveSheet.Range(ActiveSheet.Cells(.Row, .Column), ActiveSheet.Cells(ActiveSheet.Cells(.Row, .Column).End(xlDown).Row, .Column))
        r.Offset(0, -3).Value = Mid(r.value, 1, 3)
        r.Offset(0, -2).Value = Mid(r.value, 4, 3)
        r.Offset(0, -1).Value = Mid(r.value, 7)
    Next r
 End With

28/03/2012, 14h43
SylvainM

Merci beaucoup BlueMonkey ! :ccool: (et encore Mercatog aussi)
Ce code fonctionne parfaitement ! J'ai juste déplacé la séquence de nommage des "entêtes" (1ere ligne) après celle de la dé-concaténation, sinon les entêtes étaient également dé-concaténés.
Bon, je garde précieusement ce code, et je vais petit à petit essayer de comprendre chacune des fonctions utilisées.
Bonne après midi et encore MERCI !

Sylvain M.