Tri de cellules

Bonjour a tous,

J'ai essayé a plusieurs reprise a faire un macro, mais a un moment je m'y perd.

J'ai un classeur qui dans la premier page me classe des référence par couleur.(1ere ligne la couleur et ensuite les différente référence)

J'aimerais pouvoir faire un résumé en page 2

Les référence serait toutes mise en dans la première colonne et a coté de chaque référence, il y soit noté les couleurs dans lesquelles elles apparaissent.

Je vous joins un fichier ou l'exemple est fait.

Merci de votre aide

13essai-tri.xlsm (18.65 Ko)

Bonjour à tous,

En passant par PowerQuery

10essai-tri.xlsm (33.65 Ko)

Merci, ça donne un résultat exploitable pour ce que je veux faire dans un premier temps,

Mais j'aurais préféré que chaque couleur se mette dans une colonne a coté de la référence.

Quelqu'un aurait une autre solution que par Power query

Bonsoir Damsa17, DjiDji59430, le forum,

Quelqu'un aurait une autre solution que par Power query

Un essai............

2essai-triv2.xlsm (20.63 Ko)

CTRL + E pour exécuter la macro...

Option Explicit

Dim source As Worksheet, dest As Worksheet, dico, c
Dim i As Long, j As Integer, dl As Long, dc As Integer
Dim resultat, msg As String

Sub Résultat()

    Set source = Sheets("Feuil1")
    Set dest = Sheets("test")
    Set dico = CreateObject("Scripting.Dictionary")
          dl = source.UsedRange.Rows.Count
          dc = source.UsedRange.Columns.Count

    Application.ScreenUpdating = False

    dest.Cells.Delete

    With source
     For Each c In .Range(.Cells(2, 2), .Cells(dl, dc))
      If c <> "" Then dico(c.Value) = ""
     Next c
      dest.Range("A2").Resize(dico.Count, 1) = Application.transpose(dico.keys)
    End With

    For i = 1 To dest.Range("A" & Rows.Count).End(xlUp).Row
     For j = 1 To source.Cells(1, Cells.Columns.Count).End(xlToLeft).Column
      If dest.Cells(i, 1) <> "" Then
       Set resultat = source.Columns(j).Find(What:=dest.Cells(i, 1))
        If Not resultat Is Nothing Then msg = msg & source.Cells(1, j) & "      "
      End If
     Next j
      dest.Cells(i, 2) = msg: dest.Columns(2).AutoFit
      msg = ""
   Next i
End Sub

Cordialement

bonjour

toute les valeurs ,meme celles avec des virgules ????

cordialement

Rechercher des sujets similaires à "tri"