Identifier valeurs en double de la colonne A et reporter valeur colonne B

Bonjour

J'ai un fichier avec deux colonnes dans la feuil1 et j'ai besoin de le transformer dans la feuil2.

La colonne A sont les identifiants, la colonne B sont les codes.

J'ai besoin d'avoir une ligne par identifiant, avec les codes correspondants, sans avoir de doublons dans la colonne A.

Dans la colonne A "Identifiants" j'ai parfois les doublons sur plusieurs lignes.

Quand c'est le cas, j'ai donc besoin de rapatrier tous les "codes" (colonne B) correspondants à ces identifiants, sur une seule ligne et séparés d'un slash "/"

Pouvez vous m'aider à faire la macro vba

et m'aider à "formuler" le code?

"Dans la feuille 2, copie la valeur de la colonne A avec sa valeur de la colonne B,

sauf quand tu trouves plusieurs mêmes identifiants dans la colonne A.

Pour ceux-là, tu prends les valeurs de la colonne B et les concatène sur une ligne séparés d'une /

et tu colles ensuite l'identifiant de la colonne A avec les codes dans B.

13concat-code-vba.xlsx (155.88 Ko)

Bonjour,

A tester ! A mettre dans un module standard et exécuter la sub "Test()" :

Sub Test()

    Dim Tbl() As String
    Dim Plage As Range
    Dim I

    With ActiveSheet: Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
    Tbl = SansDoublon(Plage)

    Columns("C:D").Clear
    'colonne C au format texte
    Columns("C:C").NumberFormat = "@"

    'résultat en colonne C et D
    For I = 1 To UBound(Tbl, 2)

        Cells(I, 3).Value = Tbl(1, I)
        Cells(I, 4).Value = Tbl(2, I)

    Next I

End Sub

Function SansDoublon(Plage As Range) As String()

    Dim Tbl() As String
    Dim Dico As Object
    Dim Cle As Variant
    Dim Element As Variant
    Dim Cel As Range
    Dim I As Long

    'utilisation d'un dictionnaire pour supression des doublons en colonne A et concaténation
    'des codes séparés par des tirets
    Set Dico = CreateObject("Scripting.Dictionary")

    For Each Cel In Plage: Dico(Cel.Value) = Dico(Cel.Value) & Cel.Offset(, 1).Value & "-": Next Cel

    'récup des clés et éléments dans les variables
    Cle = Dico.Keys
    Element = Dico.Items

    'passage au tableau...
    For I = 0 To Dico.Count - 1

        ReDim Preserve Tbl(1 To 2, 1 To I + 1)

        Tbl(1, I + 1) = Cle(I): Tbl(2, I + 1) = Left(Element(I), Len(Element(I)) - 1)

    Next I

    'puis du tableau à la fonction
    SansDoublon = Tbl

End Function

Re,

Je viens de modifier ma fonction pour que tu puisses l'utiliser depuis Excel en matricielle (je reposte avec la proc "Test()" qui elle aussi est modifiée) :

Sub Test()

    Dim Tbl() As String
    Dim Plage As Range
    Dim I

    With ActiveSheet: Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
    Tbl = SansDoublon(Plage)

    Columns("C:D").Clear
    'colonne C au format texte
    Columns("C:C").NumberFormat = "@"

    'résultat en colonne C et D
    For I = 1 To UBound(Tbl, 1)

        Cells(I, 3).Value = Tbl(I, 1)
        Cells(I, 4).Value = Tbl(I, 2)

    Next I

End Sub

Function SansDoublon(Plage As Range) As String()

    Dim Tbl() As String
    Dim Dico As Object
    Dim Cle As Variant
    Dim Element As Variant
    Dim Cel As Range
    Dim I As Long

    'utilisation d'un dictionnaire pour supression des doublons en colonne A et concaténation
    'des codes séparés par des tirets
    Set Dico = CreateObject("Scripting.Dictionary")

    For Each Cel In Plage: Dico(Cel.Value) = Dico(Cel.Value) & Cel.Offset(, 1).Value & "-": Next Cel

    'récup des clés et éléments dans les variables
    Cle = Dico.Keys
    Element = Dico.Items

    ReDim Tbl(1 To Dico.Count, 1 To 2)

    'passage au tableau...
    For I = 0 To Dico.Count - 1

        Tbl(I + 1, 1) = Cle(I): Tbl(I + 1, 2) = Left(Element(I), Len(Element(I)) - 1)

    Next I

    'puis du tableau à la fonction
    SansDoublon = Tbl

End Function

Pour l'utiliser depuis Excel la formule est : =SansDoublon(A1:A7965) (seulement la colonne des identifiants) et elle doit être validée en matricielle (Ctrl+Maj+Entrée) après sélection de la plage (mettons E1 à F6050 puisqu'il y a 6049 identifiants uniques) donc sur deux colonnes sinon, il n'y aura que les identifiants

Merci beaucoup pour tes réponses Theze!

Je t'avoue que je n'ai pas tout compris ce que tu dis.

Ça se trouve que c'est moi qui n'a pas fait quelque chose qu'il a fallu avant de faire tourner la macro, mais

quand je veux exécuter ta deuxième macro, il me dit qu'Un composant ActiveX ne peut pas créer d'objet (erreurs 429).

Merci

Olivia

Bonjour,

Je te poste ton classeur en .xlsm (avec la procédure et fonction) :

11concat-code-vba.xlsm (407.60 Ko)

Merci Theze!!!

Rechercher des sujets similaires à "identifier valeurs double colonne reporter valeur"