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

re,

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

Jocelyn

Cliquez pour agrandir...

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

Cliquez pour agrandir...

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

Cliquez pour agrandir...

salut

Cliquez pour agrandir...

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

Cliquez pour agrandir...

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

Cliquez pour agrandir...