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

[alex75]

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]

 

[alex75]

au secours
ca marche plus

 

[alex75]

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]

 

[Hervé]

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

 

[alex75]

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

 

[alex75]

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]

 

[Hervé]

re

ben oui, y'a que 256 colonnes dans excel (vivement excel 12)

et que dois-t'on faire dans ce cas ?

ecrire le reste sur la ligne d'en dessous ?

a plus

salut

 

[alex75]

Hervé écrit:

re

ben oui, y'a que 256 colonnes dans excel (vivement excel 12)

et que dois-t'on faire dans ce cas ?

ecrire le reste sur la ligne d'en dessous ?

a plus

salut

oui je pense qu'il faudrait continuer à la ligne en dessous avec une cellule de décalage, ca évitera de faire planter le script vba...

 

[Hervé]

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

 

[Jocelyn]

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

 

[alex75]

merci bcp our votre aide, tout marche nickel