Transposition d'éléments répétitifs


#1

Bonjour,

J’ai un fichier CSV qui me sort des données au kilomètre en une seule colonne, avec des éléments répétitifs. Il se présente, en résumé, comme suit :

colonne 1 Prénom Albert
1 Nom Dupont
1 Commune Paris
1 Camping en tente
2 Prénom Géraldine
2 Nom Muller
2 Commune Montpellier
2 Camping en camion
etc

et que j’ai besoin de transposer en fonction des infos de la colonne 2
Prénom Albert Géraldine
Nom Dupont Muller
Commune Paris Montpellier
Camping en tente camion
etc

Un extrait du vrai fichier est ici http://www.cjoint.com/c/GGcs40FU8gu, avec en onglet 1 ce que j’ai, en onglet 2 ce que je souhaite.

J’ai cherché dans les fonctions transposition, recherchev, index match. J’ai conscience que ça doit être trivial, mais là je suis lost in excel. Pouvez-vous m’aider ? Merci !


#2

Bonjour

As-tu essayé de modifier la manière dont est importé le fichier CSV?
Il est surement possible de l’importer “proprement” en spécifiant le séparateur

Ci-joint un message qui détaille le fonctionnement de l’assistant d’import


#3

Bonjour @Pator,
Salut @DocteurExcel,

Une proposition différente par VBA, si ça répond à la demande.

Faire un appui sur le bouton “GO” placé sur la feuille “Fichier initial” à la hauteur de “E1”.

Traitement de la colonne “C” sans doublons, puis répartition des lignes de la colonne “D” en colonnes dans la feuille “Résultat”.

Traitement “Ne pas renvoyer à la ligne automatiquement”

Mise en forme des largeurs colonnes et mise en forme “Style de tableau moyen 7”.

Fait pour 10000 lignes, donc ajustable a partir de la macro.

La macro:

Sub GO()

Dim J As Long
Dim I As Integer
Dim K As Long
Dim Indice As Long
Dim Tablo
Dim Nb As Integer

Application.ScreenUpdating = False

  ReDim Tablo(1 To Range("A" & Rows.Count).End(xlUp).Row - 2, 1 To 2)
  Tablo(1, 1) = Range("C2")
  Tablo(1, 2) = Range("D2")
  Nb = 1
  For J = 3 To Range("A" & Rows.Count).End(xlUp).Row
    For K = 1 To UBound(Tablo)
      If Range("C" & J) = Tablo(K, 1) Then
        For I = 1 To UBound(Tablo, 2)
          If Tablo(K, I) = "" Then
            Tablo(K, I) = Range("D" & J)
            Exit For
          End If
        Next I
        If I > UBound(Tablo, 2) Then
          ReDim Preserve Tablo(1 To UBound(Tablo), 1 To UBound(Tablo, 2) + 1)
          Tablo(K, UBound(Tablo, 2)) = Range("D" & J)
        End If
        Exit For
      ElseIf Tablo(K, 1) = "" Then
        Nb = Nb + 1
        Tablo(K, 1) = Range("C" & J)
        Tablo(K, 2) = Range("D" & J)
        Exit For
      End If
    Next K
  Next J
  With Sheets("Résultat")
    .Cells.ClearContents
    .Range("A2").Resize(Nb, UBound(Tablo, 2)) = Tablo
    .Range("A1") = "Column3"
    .Range("B1") = "Column4"
    .Range("B1").AutoFill .Range("B1").Resize(, UBound(Tablo, 2) - 1), xlFillSeries
    .Select
    Rows(1).Font.Bold = True
  End With
  
Application.DisplayAlerts = False

    Rows("2:10000").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Range("A1:C32").Select
    Selection.AutoFilter
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$C$10000"), , xlYes).Name = _
        "Tableau9"
    Range("Tableau9[#All]").Select
    ActiveSheet.ListObjects("Tableau9").TableStyle = "TableStyleMedium7"
    Range("Tableau9[[#Headers],[Column3]]").Select
    
Application.DisplayAlerts = False
Application.ScreenUpdating = True

End Sub

Ci-joint ton fichier ICI==> Pator V1.xlsm (209,5 Ko)

Cordialement.

PS: Sur ce forum tu peux joindre directement ton fichier, sans passer par “cjoint.com”.

Pour ce faire suivre cette procédure:


#4

Bonjour @]DocteurExcel, bonjour @mdo100
Un grand merci, la macro marche parfaitement.
Comment puis-je vous remercier ? Si vous avez des enfants age 6-10, je peux leur envoyer un petit magazine de ma production :wink:


#5

Re @Pator,

À mon âge, je n’ais plus d’enfants de cette tranche d’âge, mais plutôt 2 petits enfants, que je gâte trop :heart_eyes:, quoi que mes grands enfants ne sont pas en reste non plus :wink: .

Je te remercie amicalement :grinning: pour ta proposition, mais tu es en mesure de comprendre que je ne partage pas d’informations personnels sur les forums.

Mais pour me remercier, tu peux cliquer sur le petit :white_check_mark: sous la solution pour la valider.

Ça me suffit largement.

Cordialement.