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.
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) :
Merci Theze!!!