Discussion :

[jpvba65]

Bonjour à tous et toutes.

Voici ce que je recherche.
J'aurais besoin d'une macro qui fasse le tri des cellules identique dans une colonne.
J'ai 4 colonnes A B C D
J'ai besoin que le tri soit fait dans la colonne D.
Exemple:
Tableau initial qui peut avoir un nombre illimité de lignes.
----A ----------B -----------C -------D
Donnée 1 -- Donnée 2-- Donnée3 --- Tri
----a ------- a ---------- a -----------1
----b ------- b------------b ----------2
----c -------c------------c ----------1
----d -------d------------d-----------2

Voici le résultat que je voudrais avoir dans un nouveau tableau (une autre feuille):

----A------------ B
---Tri-------- Données triées
----1--------EIU B(a*a*a)B(c*c*c) .
----2 -------EIU B(b*b*b)B(d*d*d) .

Le nombre de cellules pouvant être identiques dans la colonne D initiale n'est pas limitée.
Dans le tableau qui reçoit le résultat je rajoute du texte et des symboles EIU, B, (, *, ), .

Voilà donc ce que je recherche.
Je remercie par avance tous ceux ou celles qui pourront m'aider.

Bonne soirée

[mercatog]

Une proposition utilisant un dictionnaire.
Données de A2 à Bxx et résultat de F2 à Gyy

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Option Explicit
 
Sub Test()
Dim LastLig As Long, i As Long
Dim Dico As Object
Dim S As String
Dim Tb
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    Tb = .Range("A2:D" & LastLig)
End With
 
Set Dico = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Tb, 1)
    S = "B(" & Tb(i, 1) & "*" & Tb(i, 2) & "*" & Tb(i, 3) & ")"
    If Not Dico.Exists(Tb(i, 4)) Then
        Dico.Add Tb(i, 4), "EUI " & S
    Else
        Dico(Tb(i, 4)) = Dico(Tb(i, 4)) & S
    End If
Next i
 
With Worksheets("Feuil1").Range("F2").Resize(Dico.Count, 2)
    .Value = Application.Transpose(Array(Dico.Keys, Dico.Items))
    .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
End With
Set Dico = Nothing
End Sub