TRI liste

Bonsoir au forum,

N'y a t-il pas une astuce pour trier un liste de ce type (problème à partir de 10)

1) Rivet
10) Vis à tôle
100) Visserie HR, SKIN - SKUN
11) Vis à tôle
13) Vis à tôle
2) Vis sans tête, Tige filleté
3) Vis à tête hexagonale
4) Vis à tôle
5) Ecrou, Rondelle, Anneau
6) Fixation maçonnerie
7) Rivet et Tubtarra
8) Vis à bois
9) Vis à tôle
9,1) Vis à tôle
9,2) Vis à tôle

sans être obligé de mettre 9,1 - 9,2 - etc...

il me semble avoir vu une combine pour çà !

amicalement

Claude.

Bonsoir Claude,

Je ne suis pas sûre d'avoir saisi ce que tu veux faire, mais peut être qu'en définissant une liste personnalisée... puis Données Trier, Options, et dans la liste du choisis l'ordre personnalisé que tu as défini.

Amicalement,

Salut à vous deux,

peut-être qu'en obligeant les zéros non significatifs :

001)

002)

003)

Bonjour à tous,

Merci à vous deux pour vos propositions, mais çà ne m'emballe pas vraiment,

Je vais essayer de mettre des lettres à la place des chiffres,

a) Vis...

b) Vis...

c) Vis...

etc...

Comme je n'ai que 12 groupes. et là je suis sur de pouvoir trier.

Bon dimanche et encore merci.

Claude.

Bonjour,

Une question, ou plutôt deux :

• tes données sont-elles dans une seule colonne ou dans deux ?
• si dans deux colonnes, as-tu essayé de mettre la colonne de chiffres au format "texte" ?

Amicalement,

Bonjour,

Et dans la foulée de la proposition de V_Elbie, si dans une seule colonne, insérer une colonne avec cette formule :

=GAUCHE(B1;TROUVE(")";B1)-1)*1

@+

Bonsoir,

toujours dans l'idée de V_Elbie, et de Thibo, le code :

Sub tri()
Dim Cel As Range
Application.ScreenUpdating = False
Columns("A:A").Insert
For Each Cel In Range("B2:B" & [B65000].End(xlUp).Row)
    Cel.Offset(, -1) = Left(Cel, InStr(1, Cel, ")") - 1)
Next Cel
Range("A2:B" & [B65000].End(xlUp).Row).Sort Key1:=Range("A2"), Order1:=xlAscending
Columns("A:A").Delete
End Sub

Bonsoir V_Elbie, thibo, felix,

J'avais baissé les bras un peu trop vite, c'était sans compter sur les ressources du Forum !

Merci à tous.

felix, tu reconnaitras le début de la macro qui est de toi aussi,

Sub Trilist()
Dim Unique3 As Object
Dim Cel As Range
Application.ScreenUpdating = False
        '****************** Liste Super-famille ****************
    Set Unique3 = CreateObject("Scripting.Dictionary")
        For Each Cel In Range("j5:j" & [j65536].End(xlUp).Row)
            If Not Unique3.Exists(Cel.Value) Then Unique3.Add Cel.Value, Cel.Value
        Next Cel
    Range([g5], [g65536].End(xlUp)).ClearContents
    Range("g5:g" & [g65536].End(xlUp).Row).Delete Shift:=xlUp
    Range("g5:g" & Unique3.Count + 4) = Application.Transpose(Unique3.items)

    '********* TRI de la liste  8 Fevr 09 (felix) **********
Columns("g:g").Insert
    For Each Cel In Range("h5:h" & [h65000].End(xlUp).Row)
        Cel.Offset(, -1) = Left(Cel, InStr(1, Cel, ")") - 1)
    Next Cel
Range("g5:h" & [h65000].End(xlUp).Row).Sort Key1:=Range("g5"), Order1:=xlAscending
Columns("g:g").Delete
    '*******************
    Range("g4") = ".    Nouvelle Super-Famille"
    Range([g4], [g65536].End(xlUp)).Name = "Liste_SuperF"
    Set Unique3 = Nothing
End Sub

çà marche nickel, mais n'y a t-il pas risque de conflit avec les 2 boucles et la même

variable Cel As Range ?

Bonne fin de soirée à tous,

Amicalement

Claude.

Bonsoir,

Claude, aucun risque, quant à la variable Cel

Elle prend la valeur que tu lui indiques....

uniquement

Tu lui donnes une autre valeur, elle la prend....

Maintenant, le ClearContents, et le Delete font peut-être double emploi.....

re,

Ok, je vais supprimer le Delete

Petite question subsidiaire :

dans la 1ère partie de la macro (j'extrais sans doublon en G5), mais çà me vire la ligne d'en-tête

(ici G4 , que je suis obligé de réécrire à la fin)

Pas bien grave, mais est-ce inévitable ?

Claude.

Re-,

et ainsi?

Sub Trilist()
Dim Unique3 As Object
Dim Cel As Range
Application.ScreenUpdating = False
        '****************** Liste Super-famille ****************
Set Unique3 = CreateObject("Scripting.Dictionary")
    For Each Cel In Range("j5:j" & [j65536].End(xlUp).Row)
        If Not Unique3.Exists(Cel.Value) Then Unique3.Add Cel.Value, Cel.Value
    Next Cel
Range("G5:G65000").ClearContents
Range("G5:G" & Unique3.Count + 4) = Application.Transpose(Unique3.items)
    '********* TRI de la liste  8 Fevr 09 (felix) **********
Columns("G:G").Insert
    For Each Cel In Range("H5:H" & [H65000].End(xlUp).Row)
        Cel.Offset(, -1) = Left(Cel, InStr(1, Cel, ")") - 1)
    Next Cel
    Range("G5:H" & [H65000].End(xlUp).Row).Sort Key1:=Range("G5"), Order1:=xlAscending
Columns("G:G").Delete
    '*******************
End Sub

re,

Comme çà c'est bon,

Maintenant, le ClearContents, et le Delete font peut-être double emploi.....

évidement la 2ème ligne supprimait l'en-tête.

encore merci

à+.......Claude.