Tri personnalisé

Résolu
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

10 réponses

  1. Contributeur
    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
    0
    1. 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
      0
      1. Contributeur
        Alors bonne chance, VBA ce n'est pas mon domaine
        crdlmnt
        0
    2. 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
      0
      1. Contributeur
        Je peux juste dire que le tri ou le filtre par couleur de cellule ou de police fonctionne sur 2013
        Si ça ne convient pas, peut être baser la MFC sur une numérotation des lignes, dans une colonne supplémentaire pour la trier avec.

        Bonne route
        crdlmnt
        0
    3. 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
      0
      1. 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
        0
        1. J'obtiens une durée de traitement à 110,14
          C'est trop long .

          merci
          0
          1. 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
            0
            1. 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
              0