Concatener plusieurs lignes

Bonjour à tous ,

Ayant une faible connaissance dans les fonctions VBA, je souhaite concaténer plusieurs lignes sur une 3ème colonne sachant que certaines ont 1 voir plusieurs lignes dans la 1ère colonne (de 1 à 9).

Malheureusement j'ai tenté plusieurs exemples mais je n'y arrive pas

Merci pour votre aide

Bonjour le forum,

Merci mbbp pour ta réponse ultra rapide !

Mais je ne souhaite pas les additionner mais les mettre à la suite ce qui donnera par exemple pour la colonne A4, A5 et A6 (1001) le résultat suivant : 123 456 789

Merci

Est-ce le résultat attendu ?

Oui c'est cela !

Après je vais être un 'ti chouille pointilleux mais si le résultat ne pouvait s'affichait que sur la 1ère ligne de chaque case de la colonne A ce serait chouette

En tout cas l'idée est bien là !

rico76 a écrit :

si le résultat ne pouvait s'affichait que sur la 1ère ligne de chaque case de la colonne A ce serait chouette

C'est à dire cela ?

Bonjour mbbp,

C'est exactement cela ! du travail d'orfèvre ! Bravo

PS : mais je ne vois pas toute la fonction

rico76 a écrit :

C'est exactement cela ! du travail d'orfèvre ! Bravo

Merci pour ta réponse

Pas de soucis bien au contraire, il faut rendre à César ce qui appartient à César

Je vois cela cet après-midi et je te tiens au courant ainsi que pour clôturer le sujet.

Bonne journée

Bonjour rico76,

Dans ton message de 08:33, tu as écrit en PS : « mais je ne vois pas toute la fonction »

Quand tu ne peux pas voir en entier une formule très longue, fais Ctrl Maj u pour agrandir la hauteur de la barre de formules ; quand tu auras fini de consulter la formule, fais de nouveau Ctrl Maj u pour remettre la barre de formules comme elle était : hauteur d'une seule ligne ; avec la souris, tu dois cliquer sur l'icône au bout à droite de la barre de formule : guillemets vers le bas, puis ce sera guillemets vers le haut (mais c'est plus rapide avec le raccourci clavier ).

Cordialement,

dhany

Merci Dhany pour ces précisions mais ce n'est pas sur excel mais sur l'image pièce jointe .

@mbbp : Alors je viens de tester le fichier, tel que tu l'as fait, effectivement cela fonctionne.

Mais dans mon fichier d'origne cela ne fonctionne pas. Il m'a fallu le temps de comprendre le code que tu as fait et j'ai remarqué que tu as ajouté d'autres colonnes de X à AD. Qui reprends en tout point les colonnes.

Alors ce que j'avais mis en exemple était un bout de mon fichier (sans les vrais infos car c'est confidentiel) mais j'ai 14813 lignes.

Et je me vois pas faire ce que vous avez fait (qui est très bien je le rappelle) mais qui n'est pas fonctionnel pour moi.

J'étais surpris que l'on passe par une fonction au départ et non par une VBA (ma demande du départ car j'ai suivi nombreux sujet ici sur le forum).

Aurais tu une autre solution à me proposer ?

je te remercie par avance

rico76 a écrit :

J'étais surpris que l'on passe par une fonction au départ et non par une VBA (ma demande du départ car j'ai suivi nombreux sujet ici sur le forum).

En effet ma proposition est garantie sans VBA !

Ce qui n'est pas évident dans le cas présent.

Et je suis surpris qu'aucune proposition VBA ne te soit parvenue.

Désolé et bonne chance pour la suite ....

Bonsoir à tous,

mbbp a écrit:

Et je suis surpris qu'aucune proposition VBA ne te soit parvenue.

faut dire que la demande est récurrente

Option Explicit
Sub test()
Dim a, b(), i As Long, n As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    a = Sheets("feuil1").Range("a1").CurrentRegion.Value
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
    For i = 1 To UBound(a, 1)
        If Not dico.exists(a(i, 1)) Then
            n = n + 1
            b(n, 1) = a(i, 1)
            dico(a(i, 1)) = n
        End If
        b(dico(a(i, 1)), 2) = b(dico(a(i, 1)), 2) & _
                              IIf(b(dico(a(i, 1)), 2) <> "", " ", "") & a(i, 2)
    Next
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("restitution").Delete
    Sheets.Add().Name = "restitution"
    On Error GoTo 0
    With Sheets("restitution").Range("a1")
        With .Resize(n, UBound(b, 2))
            .NumberFormat = "@"
            .Value = b
            .Font.Name = "calibri"
            .Font.Size = 10
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .VerticalAlignment = xlCenter
            With .Rows(1)
                .BorderAround Weight:=xlThin
                .Interior.ColorIndex = 44
                .HorizontalAlignment = xlCenter
            End With
            .Columns.AutoFit
        End With
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

re rico76,

Ou celle-ci, si l'on souhaite garder les doublons en colonne 1, comme illustré par mbbp

Option Explicit
Sub test()
Dim a, i As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("Feuil1")
        With .Range("a2", .Range("a" & Rows.Count).End(xlUp)).Resize(, 2)
            a = .Value
            For i = 1 To UBound(a, 1)
                If Not dico.exists(a(i, 1)) Then
                    dico(a(i, 1)) = i
                Else
                    a(dico(a(i, 1)), 2) = a(dico(a(i, 1)), 2) & _
                                          IIf(a(dico(a(i, 1)), 2) <> "", " ", "") & a(i, 2)
                    a(i, 2) = ""
                End If
            Next
            .Value = a
            .Columns.AutoFit
        End With
    End With
    Set dico = Nothing
End Sub

klin89

Ah super, merci Klin89 !! Oui j'imagine que les demandes sont récurrentes ! Mais comme j'en avais testé plus d'une et qui ne fonctionnaient pas, je m'étais permis de créer un nouveau sujet

Pour ton code, j'ai juste à les mettre c'est tout ? que dois entrer comme fonction ?

Bonne journée

Bonjour Klin et Rico,

j'ai une demande assez similaire de concaténation sur plusieurs lignes sauf qu'en plus les lignes de la colonne concaténée peuvent avoir aussi des doublons ; et je ne suis pas doué en vba

J'ai essayé les 2 macros, mais lorsque cette deuxième colonne a des doublons ils sont répétés et non nettoyés (cf exemple du résultat à atteindre joint)

Bonsoir Morinjm

et bienvenue sur le forum

A tester :

Option Explicit
Sub test()
Dim a, w(), i As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    Application.ScreenUpdating = False
    With Sheets(1)
        With .Range("a2", .Range("a" & Rows.Count).End(xlUp)).Resize(, 3)
            With .Columns(3)
                .ClearContents
                .NumberFormat = "@"
                .HorizontalAlignment = xlCenter
            End With
            a = .Value
            For i = 1 To UBound(a, 1)
                If Not dico.exists(a(i, 1)) Then
                    dico(a(i, 1)) = VBA.Array(i, CreateObject("Scripting.Dictionary"))
                End If
                w = dico(a(i, 1))
                If Not dico(a(i, 1))(1).exists(a(i, 2)) Then
                    dico(a(i, 1))(1)(a(i, 2)) = Empty
                    a(dico(a(i, 1))(0), 3) = a(dico(a(i, 1))(0), 3) & _
                                             IIf(a(dico(a(i, 1))(0), 3) <> "", "|", "") & a(i, 2)
                End If
                'dico(a(i, 1)) = w
            Next
            .Value = a
            .Columns(3).AutoFit
        End With
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

La prochaine fois ouvre un nouveau fil

klin89

Merci