Simplifier un code macro en VBA pour faire un tri d'une liste personnalisée

Version imprimable

Bonjour à tous,

voici mon problème, je souhaiterai faire un code VBA pour faire un trie personnalisé dans un de mes fichiers. Ce fichier comporte des listes de noms dans des colonnes, chaque colonne représente un jour du mois. Chaque début de mois je dois trier les noms selon ma liste personnalisée. Je travaillais avant avec excel 2003, ma macro fonctionnait à merveille, maintenant je suis sous excel 2013 et là... c'est la cata...

voici le début de la macro que j'ai enregistré avec une version excel 2007, n'étant pas au boulot, mais je pense que c'est le même principe que 2013 à voir comme ça. Je n'ai fait l'enregistrement que sur deux jours, je souhaite savoir s'il n'y a pas plus simple avec un bout de code VBA
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 Range("B3:C9").Select ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("B3:C9"), _ SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ "cheval,écureuil,singe,éléphant,autruche,pingouin" _ , DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Feuil1").Sort .SetRange Range("B3:C9") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("D3:E9").Select ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("D3:E9"), _ SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ "cheval,écureuil,singe,éléphant,autruche,pingouin" _ , DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Feuil1").Sort .SetRange Range("D3:E9") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("E3").Select
N'y a-t-il pas une autre solution que cette répétition de la liste personnalisé dans le code ?
Le trie se fait sur deux colonnes pour chaque jour pour info...

Merci, pour plus de renseignements je suis à votre disposition.
Bonne journée à tous.

Bonjour,

Ton code produit une erreur sur "Apply". J'ai modifié les colonnes à trier (B et D) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("B3:B9"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "cheval,écureuil,singe,éléphant,autruche,pingouin" _
        , DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("B3:C9")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("D3:E9").Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields(1).ModifyKey Key:=Range("D3:D9")
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("D3:E9")
        .Apply
    End With

Bonsoir Daniel,
bon je vois bien ta modification mais a quoi sert-elle ? je suis pas expert et des explications pour moi sont plus que nécessaire par rapport à la partie modifié du code :
Code:

1 2 3 4 5 ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields(1).ModifyKey Key:=Range("D3:D9") With ActiveWorkbook.Worksheets("Feuil1").Sort .SetRange Range("D3:E9") .Apply End With
Est ce que c'est ce bout de code que je dois répéter pour qu'au final toutes mes listes sur les 31 colonnes représentant les jours du mois en cours se trient dans le même model de ma liste personnalisé ?

Merci pour ton aide...

J'avais aussi l'idée éventuelle de remplacer ma liste personnalisée dans le code :
Code:

1 2 3 4 ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("D3:E9"), _ SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ "cheval,écureuil,singe,éléphant,autruche,pingouin" _ , DataOption:=xlSortNormal
où se trouve CustomOrder par un nom de plage défini dans ma feuille. Ce nom de plage je le nomme par exemple : triListe et il correspondrait à ma liste personnalisée.
Mon problème est comment ajouter ce nom dans le bout de code ci-dessus et est ce qu'il doit bien se trouver derrière CustomOrder ?

Code créant ma liste personnalisée et géré part "Gestion des noms"
Code:

1 2 3 4 Range("B3:B9").Select ActiveWorkbook.Names.Add Name:="triListe", RefersToR1C1:="=Feuil1!R3C2:R9C2" ActiveWorkbook.Names("triListe").Comment = "" Range("D3").Select

Tes deux tris sont identiques, en particulier la liste perso (ou alors j'ai mal regardé). Donc au lieu d'effacer le champ de l'objet "Sort" pour en recréer un, je le modifie; au lieu de :
Code:

1 2 ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("B3:B9"), _
je change seulement la plage de la clé :

Code:

ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields(1).ModifyKey Key:=Range("D3:D9")

ce qui évite de répéter le reste. Pour la liste perso, je ne pense pas qu'on puisse faire plus simple.
Dans le cas contraire, je posterai un autre code.

Pas vraiment plus simple, sauf si tu veux conserver la liste perso qui se retrouve dans les listes perso Excel.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Dim ListID As Integer 'triListe = "cheval,écureuil,singe,éléphant,autruche,pingouin" Application.AddCustomList listarray:=Array("cheval", "écureuil", "singe", "éléphant", "autruche", "pingouin") ListID = Application.GetCustomListNum(Array("cheval", "écureuil", "singe", "éléphant", "autruche", "pingouin")) ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("B3:B9"), _ SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=ListID, _ DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Feuil1").Sort .SetRange Range("B3:C9") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("D3:E9").Select ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields(1).ModifyKey Key:=Range("D3:D9") With ActiveWorkbook.Worksheets("Feuil1").Sort .SetRange Range("D3:E9") .Apply End With
Pour la supprimer :

Code:

Application.DeleteCustomList ListID

13/11/2013, 21h49
nibledispo

simplifier un code

Bonsoir,

Je ne connaissais pas ce tri personnalisé avant lecture de ce post et il faut bien reconnaitre que l'aide n'est éloquente que pour ceux qui connaissent.
C'est dire qu'elle ne sert à rien comme trop souvent hélas pour l'aide VBA contrairement à l'aide du tableur.

Juste une question : Order:=xlAscending et CustomOrder:=ListID font-ils bon ménage ? Et si oui quelle instruction prime l'autre ?

Cordialement,
14/11/2013, 10h27
Daniel.C

Bonjour,

Je ne le connaissais qu'indirectement; dans les options d'un TCD, il y a une case cochée par défaut qui spécifie d'utiliser les listes personnalisées dans les tris. Et j'avais dans une liste de noms un nommé "Janvier" qui se classait en tête. Avec la liste proposée, je viens de faire un tri sur :
cheval
écureuil
singe
éléphant
autruche
pingouin
A
Z
avec :

Code:

Order:=xlDescending, CustomOrder:=ListID

Le tri classe bien les éléments contenant la liste perso en ordre descendant, par contre, pour les éléments ne faisant pas partie de la liste, j'obtiens :
A
pingouin
autruche
éléphant
singe
écureuil
cheval
Z
??? à creuser.
PS. Je ne sais pas si c'est le fait de créer et de supprimer la liste perso, mais Excel vient de planter pour la troisième fois ce matin.
14/11/2013, 10h37
Daniel.C

Rectification pour les tests (erreur due à une plage trop courte).
Dans l'ordre ascendant, le tri classe les éléments de la liste perso d'abord :
Z
A
cheval
écureuil
singe
éléphant
autruche
pingouin
devient :
cheval
écureuil
singe
éléphant
autruche
pingouin
A
Z
Dans l'ordre descendant, le tri classe les éléments n'appartenant pas à la liste perso en premier :
cheval
écureuil
singe
éléphant
autruche
pingouin
A
Z
devient :
Z
A
pingouin
autruche
éléphant
singe
écureuil
cheval
ce qui paraît logique.
15/11/2013, 17h11
phanoulevoyou

Bonsoir Daniel,

Bon je n'ai pas encore fait le Test de ce que tu me proposes, je le ferai demain au boulot. J'ai tout de même une question, c'est pas bien vu que je n'ai pas essayé de mon côté, dans le cas ou je veux ajouter un nom à ma liste existante ?

Dans mon premier exemple mon code vient d'une macro donc la liste des noms ne peut s'agrandir !

Si je dois ajouter un nom l'idéal n'est pas de rentrer dans mon code VBA...mais d'utiliser la liste déjà créée dans ma liste personnalisée sans pour autant la retaper... Avant de te gratter la tête je vais essayer demain et je te tiens au courant. Dans tous les cas merci de ton aide.
Cordialement.
15/11/2013, 18h02
Daniel.C

Bonjour,

A ma connaissance, tu ne peux pas modifier une liste perso. Tu ne peux que la créer ou la supprimer. Normalement, tu es obligé de la ressaisir pour obtenir son numéro; sauf si tu ne changes que la dernière liste. Personnellement je n'ai que 4 listes lesquelles sont listées dans les options avancées. Donc ta liste a toujours le numéro 5. Reste à savoir si ce sera toujours le cas surtout si tu distribues la macro sur plusieurs ordis...
Note que tu peux en importer les données depuis une plage de cellules.

Bonjour Daniel,

pour le cas précis la liste ne sera que sur mon PC, et donc ta solution de définir le numéro de liste dans le code m'intéresse fortement. D'ailleurs je pense que c'était ce cas là dans la macro faites avec excel 2003... avec 2013 la macro affiche directement la liste...

Version 2003 :
Code:

1 2 3 Range("A26:B109").Select Selection.Sort Key1:=Range("A26"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=7, MatchCase:=False, Orientation:=xlTopToBottom
Version 2013 :
Code:

1 2 3 ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("B3:B8"), _ SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ "serpent,ane,poule,cochon,cheval,pingouin", DataOption:=xlSortNormal
Le OrderCustom de 2003 a disparu... Comment le remplacer dans 2013 ?

16/11/2013, 15h10
Daniel.C

Bonjour,

Citation:

avec 2013 la macro affiche directement la liste...

Comment tu fais ? la macro affiche ce que tu lui dis et les code "2003" fonctionne avec Excel 2013.
C'est d'ailleurs curieux, cette syntaxe "2013", elle utilise un string, mais tu ne peux pas le remplacer par une variable string ?
16/11/2013, 16h37
phanoulevoyou

Re,

alors si j'utilise la macro 2003 dans 2013 sans aucune modification, ce qui me faisait un tri personnalisé se transforme avec 2013 en un tri classique par ordre alphabétique croissant et non plus via ma liste perso.

Donc oui le code fonctionne pour faire un tri mais pas selon une liste personnalisée.

Tu as raison. Utilise :

Code:

1
2
3
4
5
6
7
8
9
10
11
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("B3:B9"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=7, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("B3:C9")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Re,

bon une petite dernière pour la journée...
alors ton dernier code fonctionne. Je l'ai donc essayé en prenant en compte plusieurs colonne à la suite et là bug ! J'ai le même problème que tu m'as signalé au départ avec le code Apply.

Citation:

Ton code produit une erreur sur "Apply". J'ai modifié les colonnes à trier (B et D) :

J'ai regardé dans tous les sens et je ne vois pas ce que j'ai omis...
voici le code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 Private Sub CommandButton1_Click() ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("B3:b10"), _ SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=5, _ DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Feuil1").Sort .SetRange Range("B3:c10") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("D3:E10").Select ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields(1).ModifyKey Key:=Range("D3:D10") With ActiveWorkbook.Worksheets("Feuil1").Sort .SetRange Range("D3:E10") .Apply End With Range("f3:g10").Select ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields(1).ModifyKey Key:=Range("f3:f10") With ActiveWorkbook.Worksheets("Feuil1").Sort .SetRange Range("f3:g10") .Apply End With End Sub
alors Docteur c'est grave...
Merci encore pour ta patience et ton aide.
Bonne soirée.

16/11/2013, 19h49
nibledispo

simplifier un code

Bonsoir phanoulevoyou,

Ta dernière intervention m'interpelle car suite à la réponse de Daniel je me suis empressé de faire l'essai sur ma version 2013 et il me fait bien un tri en tenant compte de la liste personnalisée tant en ascendant qu'en descendant.

d'ailleurs, merci Daniel pour cette réponse qui m'a permis de constater la complémentarité des deux instructions.

Cordialement,
16/11/2013, 23h22
phanoulevoyou

Bonsoir nible...

Effectivement dans mon message je dis à Daniel que son bout de code fonctionne et un bien grand merci à lui de sa patience et de sa gentillesse à aider les autres. Le seul couac, si couac il y a, le test sur une colonne Ok pour moi, mais lorsque j'ai voulu en tester plusieurs j'ai eu de nouveau une erreur de code sur Apply. Le pourquoi je n'en sais rien... Sachant qu'au final ce code je dois l'utiliser tous les mois sur 31 jours avec 2 colonnes par jour.

Et toi, tu l'as essayé sur une colonne ou plusieurs ?

Bonne nuit.
PLV (PhanouLeVoyou)
17/11/2013, 06h01
nibledispo

1 pièce(s) jointe(s)

simplifier un code

Bonjour,

Voici le code que j'ai fait en fonction des précédents essais.

Le premier code correspond à ce que j'ai cru comprendre de ta demande.
Tu verras à l'adapter à ce que tu recherches. En tout cas cet exemple restitue ce qui est demandé.
Je n'ai pas mis b3:b9 mais uniquement "entete" (b1) et ensuite la "plage"
J'ai remplacé xlguess par xlyes car il vaut mieux préciser que laisser VBA choisir.

Ne me demandes surtout pas d'expliquer. Mes connaissances se bornent à constater qu'un code marche ou ne marche pas.

Cordialement
17/11/2013, 11h07
phanoulevoyou

Bonjour nible,

je viens de tester ton petit fichier à la maison...que dire bravo ! ça fonctionne comme je le souhaite selon mes réglages et ma demande. Il me reste à contrôler sur mon fichier du boulot (pas avant mercredi) pour identifier ce message comme résolu si tout fonctionne.

Toutefois j'aimerai savoir via Daniel, le pourquoi avec son bout de code qui, je n'en doute pas fonctionne, du moins j'ai réussi une fois à le faire fonctionner pour une colonne mais depuis plus rien, j'ai toujours ce fameux problème Apply.

Merci à toi nibledispo et merci à Daniel.

Bon dimanche,

PLV (PhanouLeVoyou)
17/11/2013, 11h48
Daniel.C

1 pièce(s) jointe(s)
Au début, il faut mettre :

Code:

ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear

Sinon, la ligne :
Code:

1 2 3 ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("B3:b10"), _ SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=4, _ DataOption:=xlSortNormal
crée un nouveau champ de tri. S'il y en existait déjà un sur la même plage, ça râle... En icône, j'ai mis la représentation des deux sortfields.
17/11/2013, 12h23
phanoulevoyou

Un grand merci...

Bonjour Daniel,

je savais bien ça ne pouvait venir que de moi et qu'il me manquait quelque chose.
Ca marche impeccable, j'ai deux codes pour le prix d'un, le tien et celui de nibledispo, merci encore à tous les deux...
Mais bon je vais peut être vous retrouver bientôt dans de nouvelles aventures car j'ai encore des bugs suite au passage de office 2003 à 2013... sur d'autres sujets mais toujours en vba (filesearch par exemple qui n'existe plus depuis 2007, on me dit rien à moi...)

Sinon Daniel merci pour ton icône mais ça reste un peu chinois pour moi mais je vais faire l'effort d'essayer de comprendre ce que tu m'as envoyé.

Bonne journée à tous.

PLV.