Tri personnalisé
Résolu
julia Namor
Messages postés
532
Statut
Membre
-
julia Namor Messages postés 532 Statut Membre -
julia Namor Messages postés 532 Statut Membre -
Bonjour,
Je souhaiterai appliquer un tri Az sur une plage en fonction d'une colonne , jusque là pas de soucis ;
Le probléme est que les mises en formes des lignes ne se déplacent pas
Une bonne volonté pour m'aiguiller?
le fichier d'exemple
https://www.cjoint.com/c/GDjgwIYDOZQ
merci beaucoup
Je souhaiterai appliquer un tri Az sur une plage en fonction d'une colonne , jusque là pas de soucis ;
Le probléme est que les mises en formes des lignes ne se déplacent pas
Une bonne volonté pour m'aiguiller?
le fichier d'exemple
https://www.cjoint.com/c/GDjgwIYDOZQ
merci beaucoup
10 réponses
-
Bonjour
mise en forme conditionnelle, peut être:- effacer la mise en forme actuelle
- sélectionner A1:X12
- MFC par formule:
=LIGNE()=12 formater jaune- idem pour les autres N° de lignes et couleurs assorties
crdlmnt
-
Merci pour la proposition
J'aurai souhaité par contre une solution vba car le tri se trouve au milieu de procédures vba de création et d'exploitation d'une base de données
Bien merci -
Merci d'voir essayé
je vais quand meme potasser sur votre prosition ave la MFC car j'ai l'impression que excel 10 ne permet pas le tri avec format
cordialement -
-
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question -
-
Bonjour
Tres bonne approche qui répond tout à fait à la problématique
Seulement , le traitement est bigrement long sur ma plage de base de données d'environ 200 lignes et les colonnes allant jusqu'a "JXY"
merci de votre aide -
Bonjour
Avec le blocage des calculs intermédiaires, on gagne un peu de temps.Option Compare Text Sub Tri() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual deb = Timer For i = 8 To 190 For j = 8 To 190 If Cells(j, "F") > Cells(j + 1, "F") Then Range(Cells(j, "F"), Cells(j, "JXY")).Copy Destination:=Range(Cells(1, "F"), Cells(1, "JXY")) Range(Cells(j + 1, "F"), Cells(j + 1, "JXY")).Copy Destination:=Range(Cells(j, "F"), Cells(j, "JXY")) Range(Cells(1, "F"), Cells(1, "JXY")).Copy Destination:=Range(Cells(j + 1, "F"), Cells(j + 1, "JXY")) End If Next j Next i Range(Cells(1, "F"), Cells(1, "JXY")).Clear Application.Calculation = xlCalculationAutomatic MsgBox "durée: " & Timer - deb End Sub
Si ça vous convient.
Cdlt -
J'obtiens une durée de traitement à 110,14
C'est trop long .
merci -
Désolé, j'ai tenté autre chose mais les résultats ne sont guère meilleurs.
Je sais que 110 secondes c'est long, mais vu ce que vous demandez (conservation des couleurs et divers formats utilisés dans les cellules), cela nécessite quelques manipulations gourmandes en ressources.
Je remets le code avec le nombre de ligne indéterminé. Peut-être que quelqu'un aura une meilleure idée.Sub Tri() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual deb = Timer DerLig = [F10000].End(xlUp).Row For i = 8 To DerLig - 1 For j = 8 To DerLig - 1 If Cells(j, "F") > Cells(j + 1, "F") Then Range(Cells(j, "F"), Cells(j, "JXY")).Copy Destination:=Range(Cells(1, "F"), Cells(1, "JXY")) Range(Cells(j + 1, "F"), Cells(j + 1, "JXY")).Copy Destination:=Range(Cells(j, "F"), Cells(j, "JXY")) Range(Cells(1, "F"), Cells(1, "JXY")).Copy Destination:=Range(Cells(j + 1, "F"), Cells(j + 1, "JXY")) End If Next j Next i Range(Cells(1, "F"), Cells(1, "JXY")).Clear Application.Calculation = xlCalculationAutomatic MsgBox "durée: " & Timer - deb End Sub
Cdlt -
Merci en tout cas
déja avec le dernier code on arrive à 14 secondes de traitement
C'est toujours mieux
Je reste toujours ouverte à toute autre proposition
Bien cordialement