Concatener des lignes selon la valeur de deux colonnes

Bonjour !

Dans mon tableur, j'ai besoin que les informations contenues dans la troisième colonne soit sur la même ligne que l'information contenue dans la quatrième colonne lorsque la valeur des colonne 1 et 2 sont semblables.

Rien ne vaut un exemple pour exprimer ce que j'essais d'expliquer . J'ai mis des couleurs, jaune et vert pour aider à reperer les lignes donts les actions spécifiques et les acteurs sont identiques.

Extrait de mon fichier de base :

Puis, un exemple de ce que j'ai besoin comme résultats:

Jai aussi mis ces tableurs dans un fichier joint. Dans le premier onglet j'ai mis ou j'en suis actuellement.

Comme j'ai déjà fait pas mal de manip grâce à l'aide de pro d'excel sur ce forum

j'ai mis dans le deuxième onglet un extrait de mon fichier de base.

Extrait de mon fichier de départ avant les manips que j'ai fait jusqu'à maintenant :

Pour l'instant, j'ai utilisé le code de MFerrand

Sub ActionsPorteurs()
    Dim aa, d As Object, asac, ac, aap() As String, i%, k%, prt As Boolean
    Set d = CreateObject("Scripting.Dictionary")
    aa = ActiveSheet.Range("A1").CurrentRegion
    For k = 2 To UBound(aa, 2)
        ac = Trim(aa(1, k))
        If InStr(1, ac, "porteur") Then
            prt = True
            ac = Trim(Replace(ac, "porteur", ""))
        End If
        For i = 2 To UBound(aa, 1)
            If aa(i, k) <> "" Then
                asac = aa(i, 1) & "|" & ac
                If d.exists(asac) Then
                    If prt Then d(asac) = aa(i, k)
                Else
                    d(asac) = IIf(prt, aa(i, k), "")
                End If
            End If
        Next i
        prt = False
    Next k
    ReDim aap(d.Count, 2): i = 0
    For Each ac In d.keys
        asac = Split(ac, "|"): i = i + 1
        aap(i, 0) = asac(0): aap(i, 1) = asac(1): aap(i, 2) = d(ac)
    Next ac
    aap(0, 0) = "Actions spécifiques"
    aap(0, 1) = "Acteurs": aap(0, 2) = "Porteur"
    With Worksheets("Feuil2").Range("A1")
        .CurrentRegion.Clear
        With .Resize(i + 1, 3)
            .Value = aap
            .Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
            .Columns.AutoFit
            .Borders.Weight = xlThin
            .Columns(1).HorizontalAlignment = xlRight
            With .Rows(1)
                .Font.Bold = True
                .HorizontalAlignment = xlCenter
            End With
        End With
        .Worksheet.Activate
    End With
End Sub

Que j'ai utilisé en deux fois, la première pour remplir ma colonne porteur, et la deuxième pour remplir ma colonne statut (j'ai changé le mot dans le code pour y arriver). L'idée d'avoir une deuxième colone statut est venue après l'aide de MFerrand. Mais voila, je me retrouve devant un nouveau problème où j'ai trop de ligne pour l'information que j'ai...

Merciii pour votre aide extraordinaire !

Bonjour,

Ce n'est pas une nouvelle question à traiter à part... Il convient d 'intégrer "statut" pour le lier à "porteur" si le cas survient, et produire un tableau à 4 colonnes au lieu de 3...

Il ne doit pas y avoir grand chose à modifier dans la procédure... Je trouverai un moment pour regarder dans la journée.

Voilà pour avancer :

Sub ActionsStatutPorteurs()
    Dim aa, d As Object, asac, ac, aap() As String, i%, k%, prt%
    Set d = CreateObject("Scripting.Dictionary")
    aa = ActiveSheet.Range("A1").CurrentRegion
    For k = 2 To UBound(aa, 2)
        ac = Trim(aa(1, k))
        If InStr(1, ac, "porteur") Then
            prt = 2: ac = Trim(Replace(ac, "porteur", ""))
        ElseIf InStr(1, ac, "statut") Then
            prt = 1: ac = Trim(Replace(ac, "statut", ""))
        End If
        For i = 2 To UBound(aa, 1)
            If aa(i, k) <> "" Then
                asac = aa(i, 1) & "|" & ac
                If d.exists(asac) Then
                    If prt > 0 Then d(asac) = _
                     IIf(prt = 1, aa(i, k) & d(asac), d(asac) & aa(i, k))
                Else
                    If prt > 0 Then
                        d(asac) = IIf(prt = 1, aa(i, k) & ";", ";" & aa(i, k))
                    Else
                        d(asac) = ";"
                    End If
                End If
            End If
        Next i
        prt = 0
    Next k
    ReDim aap(d.Count, 3): i = 0
    For Each ac In d.keys
        asac = Split(ac, "|"): i = i + 1: aap(i, 0) = asac(0): aap(i, 1) = asac(1)
        asac = Split(d(ac), ";"): aap(i, 2) = asac(0): aap(i, 3) = asac(1)
    Next ac
    aap(0, 0) = "Actions spécifiques": aap(0, 1) = "Acteurs"
    aap(0, 2) = "Statut": aap(0, 3) = "Porteur"
    With Worksheets("Feuil2").Range("A1")
        .CurrentRegion.Clear
        With .Resize(i + 1, 4)
            .Value = aap
            .Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
            .Columns.AutoFit
            .Borders.Weight = xlThin
            .Columns(1).HorizontalAlignment = xlRight
            With .Rows(1)
                .Font.Bold = True
                .HorizontalAlignment = xlCenter
            End With
        End With
        .Worksheet.Activate
    End With
End Sub

A tester sur un tableau initial (évidemment pas sur le fichier joint à ce sujet !)

Cordialement.

Bonjour MFerrand !

Je ne savais pas, en effet, s'il s'agissait d'un nouveau sujet ou de la suite de celui déjà posté, à mon sens il s'agissait d'un tout nouveau problème, mais dans le doute, j'ai préféré ajouter le tableau de base (je me suis rendue compte ce matin que le deuxième onglet n'a pas suivi dans mes manip... ) et le code que j'avais utilisé jusque là.

Je viens de tester votre nouveau code et ça fonctionne très bien ! Je vais le tester cet après midi (je suis sur le fuseau horaire du québec) avec différent format de fichiers, noms de colonne et ajouts qu'il pourrait survenir au cours du projet , je vais voir si j'arrive à faire les ajustement d'usage . Un gros gros merci pour votre aide si précieuse !

Bonjour, (?)

Etant en UTC+4h, ça fait un gros écart... mais je n'ai pas d'horaires... !

Bonjour,

Je me permets de m'incruster, j'ai publié ce matin sur le site afin d'avoir de l'aide sur une thématique qui se rapproche de celle ci, je vous mets le lien ci dessous dans le cas où certains voudraient m'aider.

Je vous en remercie.

https://forum.excel-pratique.com/viewtopic.php?f=2&t=136796#top