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

  • Initiateur de la discussion Initiateur de la discussion alex75
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

alex75

XLDnaute Nouveau
Bonjour à tous,

Je suis débutant dans excel, et j'ai un besoin urgent que je n'arrive pas à résoudre.

Je m'explique, j'ai un tableau trié selon des utilisateurs et je voudrais le trier par profil et non plus pas utilisateur.

Chaque profil peut contenir X utilisateurs, j'ai donc besoin de récupérer la liste d'utilisateurs pour chacun des profils.

Vous trouverez un exemple en pièce jointe de ce que je souhaite réaliser.

J'attends vos lumières avec impatience,
Merci pour votre aide précieuse

alex [file name=classeurAlex.zip size=1778]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/classeurAlex.zip[/file]
 

Pièces jointes

Jocelyn écrit:
re,

fichier Ziper de moins de 50k avec un nom ne comportant ni accent, ni caractere spéciaux, ni espaces.

Jocelyn

Heureusement que vous êtes là 🙂
on voit que c'est le matin
j'ai oublié de le zipper 🙂 [file name=testClasseurAlex.zip size=9684]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/testClasseurAlex.zip[/file]
 

Pièces jointes

Bonjour alex
salut jocelyn

pour repondre à ta derniere demande :


Option Explicit
Sub Bouton1_QuandClic()
'necessite l'activation de la reference : microsoft scripting runtime
Dim data As New Dictionary
Dim tablo, valeur, element
Dim i As Integer, ligne 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, 1), .Cells(data.Count, 1)) = Application.Transpose(data.Keys)
       
For Each element In data.Items
                ligne = ligne + 1
                tablo = Split(element, ',')
                .Cells(ligne, 2).Resize(1,
UBound(tablo) + 1) = tablo
       
Next element
End With

End Sub

salut
 
Hervé écrit:
Bonjour alex
salut jocelyn

pour repondre à ta derniere demande :


Option Explicit
Sub Bouton1_QuandClic()
'necessite l'activation de la reference : microsoft scripting runtime
Dim data As New Dictionary
Dim tablo, valeur, element
Dim i As Integer, ligne 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, 1), .Cells(data.Count, 1)) = Application.Transpose(data.Keys)
       
For Each element In data.Items
                ligne = ligne + 1
                tablo = Split(element, ',')
                .Cells(ligne, 2).Resize(1,
UBound(tablo) + 1) = tablo
       
Next element
End With

End Sub

salut

salut hervé, :silly:
ca marche super mais je suis confronté à un pb de taille du tableau... je me retrouve sur une même ligne 'profil1' par exemple avec plus de 255 noms et le script vba plante à un moment... :S
 
Ca marche vraiment nickel... mais j'ai ce petit pb de mémoire je pense qui fait planter le script (cf le fichier en pièce jointe) [file name=test_20060425102559.zip size=32257]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/test_20060425102559.zip[/file]
 

Pièces jointes

re a tous

peut etre comme ceci, alors :


Option Explicit
Sub Bouton1_QuandClic()
'necessite l'activation de la reference : microsoft scripting runtime
Dim data As New Dictionary
Dim tablo, valeur, element
Dim i As Integer, ligne As Integer
Dim j As Integer, colonne As Integer


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')
        .Cells.ClearContents
       
For i = 0 To data.Count - 1
                colonne = 1
                ligne = ligne + 1
                .Cells(ligne, 1) = data.Keys(i)
                tablo = Split(data.Items(i), ',')
               
For j = 0 To UBound(tablo)
                       
If j = 255 Then
                                ligne = ligne + 1
                                colonne = 1
                                .Cells(ligne, 1) = data.Keys(i)
                       
End If
                colonne = colonne + 1
                .Cells(ligne, colonne) = tablo(j)
               
Next j
       
Next i
End With

End Sub


salut
 
re,

alors si tu es confronté a 255 nom pour un même profil la fonction index en matricielle pourrait fonctionnée mais elle n'est absoluement pas indiquée en raison de son temps de traitement et je vais comme pour le premier jet de macro de hervé etre confronté au nombre de colonne.

donc index a oublier trés vite Désolé

Jocelyn
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour