[HELP] Trier des données selon un critère

Sub Bouton1_QuandClic()
'necessite l'acitvation de la reference : microsoft scripting runtime
Dim data As New Dictionary
Dim tablo, valeur
Dim i As Integer
Dim j As Byte


tablo = Range('a1').CurrentRegion

For i = 2 To UBound(tablo)
        For j = 2 To UBound(tablo, 2)
                If Not tablo(i, j) = '' Then
                        With data
                                If .Exists(CStr(tablo(i, j))) = True Then
                                        valeur = .Item(tablo(i, j))
                                        .Remove (tablo(i, j))
                                        .Add Item:=valeur & ',' & tablo(i, 1), Key:=CStr(tablo(i, j))
                                Else
                                        .Add Item:=tablo(i, 1), Key:=CStr(tablo(i, j))
                                End If
                        End With
                End If
        Next j
Next i

With Sheets('feuil2')
        .Range(.Cells(1, 2), .Cells(data.Count, 2)) = Application.Transpose(data.Items)
        .Range(.Cells(1, 1), .Cells(data.Count, 1)) = Application.Transpose(data.Keys)
End With

End Sub

Cliquez pour agrandir...

Bonjour alex

en piece jointe, une solution possible parmis d'autres en vba.

attention : renvoi en feuille 2

j'ai opté pour la premiere présentation, pour la deuxieme, pas de problème.

salut [file name=classeurAlex_20060424164823.zip size=9380]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/classeurAlex_20060424164823.zip[/file]

Cliquez pour agrandir...

Sub Bouton1_QuandClic()
'necessite l'acitvation de la reference : microsoft scripting runtime
Dim data As New Dictionary
Dim tablo, valeur
Dim i As Integer
Dim j As Byte


'tablo = Range('a1').CurrentRegion
tablo = Selection

For i = 1 To UBound(tablo)
        For j = 2 To UBound(tablo, 2)
                If Not tablo(i, j) = '' Then
                        With data
                                If .Exists(tablo(i, j)) = True Then
                                        valeur = .Item(tablo(i, j))
                                        .Remove (tablo(i, j))
                                        .Add Item:=valeur & ',' & tablo(i, 1), Key:=tablo(i, j)
                                Else
                                        .Add Item:=tablo(i, 1), Key:=tablo(i, j)
                                End If
                        End With
                End If
        Next j
Next i

With Sheets('feuil2')
        .Range(.Cells(1, 2), .Cells(data.Count, 2)) = Application.Transpose(data.Items)
        .Range(.Cells(1, 1), .Cells(data.Count, 1)) = Application.Transpose(data.Keys)
End With

End Sub

Cliquez pour agrandir...

re alex

attention de bien sélectionner la colonne A avec tes données.

salut

Cliquez pour agrandir...

Bonjour le Forum,
Bonjour Alex75, Hervé 🙂

bon alors aprés la proposition en macro que personnellement je préfére voila une solution en formule matricielle basée sur la présentation numéro 2.

Jocelyn [file name=classeurAlex_20060424171023.zip size=9918]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/classeurAlex_20060424171023.zip[/file]

Cliquez pour agrandir...

re,

alors je vais essayer de t'expliquer la formule,

dans un premier temps c'est une formule Matricielle elle est a validée pour cela quand la formule est fini d'ecrire il faut positionner le curseur a la fin de la formule et appuyer simulanément sur les touche ctrl+majuscule+entrée a ce moment apparait avant le signe = le signe{ et en fin de formule le signe}

autrement :

=INDEX(Feuil1!$A$1:$A$26;MIN(SI(Feuil1!$A$3:$A$27diferendde'';SI(Feuil1!$B$3:$F$27=Feuil2!$A1;SI(NB.SI($C1:C1;Feuil1!$A$3:$A$27)=0;LIGNE(Feuil1!$A$3:$A$27))))))&''

INDEX(Feuil1!$A$1:$A$26 veut dire que l'on regardé les valeur de cette plage et que l'on veux renvoyer la valeur de la ou les plus petite lignes LIGNE(Feuil1!$A$3:$A$27)a la condition 1 que les cellule de la plage ne soit pas vide Feuil1!$A$3:$A$27diferendde'' et condition 2 il y est sur la meme ligne la valeur de la cellule A1 de la feuille 2 soit pour C1 la valeur 'ds' Feuil1!$B$3:$F$27=Feuil2!$A1 condition 3 pour éviter les doublons que le nombre de nom rencntrer sur la ligne ne soit pas deja present sur la ligne 1 de la feuille 2 NB.SI($C1:C1;Feuil1!$A$3:$A$27)=0 le fait d'ecrire $c1:C1 permet de compter si l'on tire la formule vers la droite sur une plage $C1:C2

Voila j'espere que les explications sont clair.

Jocelyn

edit pour que la formule fonctionne il faut que le ligne 1 de la feuille 1 soit vide.Message édité par: Jocelyn, à: 24/04/2006 17:58

Cliquez pour agrandir...

re alex

oui c'est possible comme ceci :

Sub Bouton1_QuandClic()
'necessite l'acitvation de la reference : microsoft scripting runtime
Dim data As New Dictionary
Dim tablo, valeur
Dim i As Integer
Dim j As Byte


'tablo = Range('a1').CurrentRegion
tablo = Selection

For i = 1 To UBound(tablo)
        For j = 2 To UBound(tablo, 2)
                If Not tablo(i, j) = '' Then
                        With data
                                If .Exists(tablo(i, j)) = True Then
                                        valeur = .Item(tablo(i, j))
                                        .Remove (tablo(i, j))
                                        .Add Item:=valeur & ',' & tablo(i, 1), Key:=tablo(i, j)
                                Else
                                        .Add Item:=tablo(i, 1), Key:=tablo(i, j)
                                End If
                        End With
                End If
        Next j
Next i

With Sheets('feuil2')
        .Range(.Cells(1, 2), .Cells(data.Count, 2)) = Application.Transpose(data.Items)
        .Range(.Cells(1, 1), .Cells(data.Count, 1)) = Application.Transpose(data.Keys)
End With

End Sub

Cliquez pour agrandir...

attention de bien sélectionner la colonne A avec tes données.

salut

Cliquez pour agrandir...