Tri automatique

Novasim220 -  
Bonjour à tous,
voila mon problème et si quelqu'un pourrait m'aider çà serait sympa.
Je rentre des valeurs dans une feuille excel via des textbox dans un USF.
Dans la première txtbox je rentre un nombre mais il se peut que je rentre d'autres nombres mais pas dans un ordre logique.
Comment faire pour pouvoir les trier du + petit au + grand automatiquement, ou est ce que ce tri doit se faire dans la feuille Excel ???
Merci pour votre aide

11 réponses

  1. Lupin
    Slt,

    En effet, puisque ta "variable" de "stockage" est la feuille, ce serait
    logique de trier sur la feuille. En VB, certains objets permettent
    un tri automatique lors de la méthode "Add", mais cette fonctionalité
    n'est pas reconduit dans les objets VBA. Toutefois il est simple par
    code vba d'effectuer un tri automatique de la feuille après chaque saisi.

    Lupin
    0
    1. Novasim220 Auteur
      Re Salut,

      Toutefois il est simple par
      code vba d'effectuer un tri automatique de la feuille après chaque saisi.
      Peux tu m'expliquer comment faire ?
      Merci de ton aide!!
      0
  2. Lupin
    Salut,

    Une fois que tu as la structure, il te suffit d'effectuer les opérations
    une par une sous l'enregistreur de macro !

    Voici un exemple de ce que cela pourraît être : 

    Private Sub cmd_Valide_Click()

    Dim Position As String
    Dim Limite As Long

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    If (Tbx_Col_B.Value <> "") Then
        If (Tbx_Col_C.Value <> "") Then
            If (Tbx_Col_D.Value <> "") Then
                ActiveCell.Offset(0, 0).Value = (ActiveCell.Row - 1)
                ActiveCell.Offset(0, 1).Value = Tbx_Col_B.Value
                ActiveCell.Offset(0, 2).Value = Tbx_Col_C.Value
                ActiveCell.Offset(0, 3).Value = Tbx_Col_D.Value
                Tbx_Col_B.Value = ""
                Tbx_Col_C.Value = ""
                Tbx_Col_D.Value = ""
                ActiveCell.Offset(1, 0).Select
            End If
        End If
    End If
    
    ' Capture de la position de la cellule active pour repositionnement
    Position = ActiveCell.Address
    'Sélection de la feuille
    Cells.Select
    ' Tri sur la colonne B & C & D
    Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("C2") _
        , Order2:=xlAscending, Key3:=Range("D2"), Order3:=xlAscending, Header:= _
        xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
        xlSortNormal
    'Dernière cellule à inclure dans le tri
    Limite = (Range("A2").End(xlDown).Row - 1)
    Range("A2:A" & Limite + 1).Select
    ' Tri sur la colonne A
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    'Fin de tri, reprendre position courante
    Range(Position).Select
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub
'


    Lupin
    0
    1. Lupin
      re : 

          Limite = Range("A2").End(xlDown).Row
    Range("A2:A" & Limite).Select


      Lupin
      0
      1. Lupin
        re :

        et même le tri n'est nécessaire que s'il y a ajout ! 

        Private Sub cmd_Valide_Click()

    Dim Position As String
    Dim Limite As Long

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    If (Tbx_Col_B.Value <> "") Then
        If (Tbx_Col_C.Value <> "") Then
            If (Tbx_Col_D.Value <> "") Then
                ActiveCell.Offset(0, 0).Value = (ActiveCell.Row - 1)
                ActiveCell.Offset(0, 1).Value = Tbx_Col_B.Value
                ActiveCell.Offset(0, 2).Value = Tbx_Col_C.Value
                ActiveCell.Offset(0, 3).Value = Tbx_Col_D.Value
                Tbx_Col_B.Value = ""
                Tbx_Col_C.Value = ""
                Tbx_Col_D.Value = ""
                ActiveCell.Offset(1, 0).Select
                
                ' Capture de la position de la cellule active
                Position = ActiveCell.Address
                Cells.Select
                ' Tri sur la colonne B & C & D
                Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("C2") _
                    , Order2:=xlAscending, Key3:=Range("D2"), Order3:=xlAscending, Header:= _
                    xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                    DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
                    xlSortNormal
                Limite = Range("A2").End(xlDown).Row
                Range("A2:A" & Limite).Select
                Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
                    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                    DataOption1:=xlSortNormal
                Range(Position).Select
            End If
        End If
    End If
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub
'


        Lupin
        0
        1. Novasim220 Auteur
          Salut Lupin,
          Merci pour ta réponse ,malheureusement je ne pourrai pas la tester ce soir ni demain.
          En tous les cas merci et joyeux noel. Je te tiens au courant lundi.
          Bon réveillon

          Amicalement.
          0
      3. Novasim220 Auteur
        Salut Lupin,
        Comme promis je te tiens au courant de ton code pour le tri des données.
        Après adaptation à mon projet , je confirme que cela fonctionne comme j'avais besoin et tant remercie.
        Si je peux me permettre, je te soumet 2 petites "anomalies"

        1°) les données sont écrites dans une feuille: si la cellule active n'est pas la bonne, les données sont écrites "n'importe ou" en fait à l'endroit ou se trouve la cellule active. Par contre si la cellule active est la bonne pas de problème!!

        2°)Imaginons que je supprime une ligne dans la feuille Excel, lors de la saisie d'une nouvelle valeur le tri s'effectue correctement mais ne réutilise pas l'index de la valeur supprimée (colonne A)
        Vois tu une possibilité ???
        Merci d'avance
        Novasim
        0
        1. Lupin
          Salut Novasim,

          Et que pense tu de ceci : 

          Private Sub cmd_Valide_Click()

    Dim Position As String
    Dim Limite As Long
    Dim Feuille As String
    Dim Flag As Boolean

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Feuille = ActiveSheet.Name
    
    'Choix de la cellule active
    Sheets("Feuil1").Select
    Limite = (Range("A2").End(xlDown).Row + 1)
    Range("A" & Limite).Select
    
    Flag = VerifieIndex
    
    If (Tbx_Col_B.Value <> "") Then
        If (Tbx_Col_C.Value <> "") Then
            If (Tbx_Col_D.Value <> "") Then
                ActiveCell.Offset(0, 0).Value = (ActiveCell.Row - 1)
                ActiveCell.Offset(0, 1).Value = Tbx_Col_B.Value
                ActiveCell.Offset(0, 2).Value = Tbx_Col_C.Value
                ActiveCell.Offset(0, 3).Value = Tbx_Col_D.Value
                Tbx_Col_B.Value = ""
                Tbx_Col_C.Value = ""
                Tbx_Col_D.Value = ""
                ActiveCell.Offset(1, 0).Select
                
                ' Capture de la position de la cellule active
                Position = ActiveCell.Address
                Cells.Select
                ' Tri sur la colonne B & C & D
                Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("C2") _
                    , Order2:=xlAscending, Key3:=Range("D2"), Order3:=xlAscending, Header:= _
                    xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                    DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
                    xlSortNormal
                Limite = Range("A2").End(xlDown).Row
                Range("A2:A" & Limite).Select
                Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
                    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                    DataOption1:=xlSortNormal
                Range(Position).Select
            End If
        End If
    End If
    
    Sheets(Feuille).Select
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub
'

Private Function VerifieIndex() As Boolean
    
    Dim Ligne As Long
    Dim Resultat As Variant
    
    
    Ligne = Range("A2").End(xlDown).Row
    If (Range("A" & Ligne).Value <> Ligne - 1) Then
        'Refaire index
        Range("A2").Select
        While (ActiveCell.Offset(0, 0).Value <> "")
            ActiveCell.Offset(0, 0).Value = (ActiveCell.Row - 1)
            ActiveCell.Offset(1, 0).Select
        Wend
    End If

End Function


          Lupin
          0
          1. Lupin
            re :

            point 1 :

            Feuille = ActiveSheet.Name

            'Choix de la cellule active
            Sheets("Feuil1").Select
            Limite = (Range("A2").End(xlDown).Row + 1)
            Range("A" & Limite).Select
            ...
            ...
            ...
            Sheets(Feuille).Select 'Retour à la feuille en cours

            point 2 :

            Flag = VerifieIndex

            Lupin
            0
            1. Novasim220 Auteur
              Salut Lupin,
              vais essayer tout çà dans la matinée et te tiens au courant
              Sympa de ta part,
              Merci encore @+
              0
              1. Novasim220 Auteur
                Salut Lupin,
                je viens d'adapter ton nouveau code a mon projet et çà fonctionne à merveille . Je te remercie de t'être cassé la tête pour moi.
                Cependant je n'ai pas compris pour ton second post:
                point 1 :
                Feuille = ActiveSheet.Name
                'Choix de la cellule active
                Sheets("Feuil1").Select
                Limite = (Range("A2").End(xlDown).Row + 1)
                Range("A" & Limite).Select
                ...
                ...
                ...
                Sheets(Feuille).Select 'Retour à la feuille en cours
                point 2 :
                Flag = VerifieIndex

                étant donné que tout fonctionne correctement ? que dois je faire avec ces nouvelles lignes ????
                Sont elles nécessaires ????
                Encore une fois et au risque de me répéter je te remercie vivement et si tu veux voir ce pour quoi tu as bossé ; pas de problème dis le moi et je t'enverrai mon classeur.
                Bon après midi(neigeux)
                a bientôt
                Novasim220
                0
                1. Lupin
                  Slt,

                  Le second message n'était que pour faire ressortir les
                  changements apportés en réponse aux 2 points que tu
                  avais soulevé.

                  Donc, la différence est le message 5 et 8 est reproduit
                  au message 9.

                  Je suis bien content que le tout réponde à tes attentes,
                  c'est une façon de faire mais il y en a plusieurs autres.
                  Même si je code sous VBA depuis 10 ans, je ne me qualifie
                  pas d'expert, et je sais pertinament qu'il y a des façons
                  de faire encore plus efficace.

                  Lorsque j'ouvre mon bouquin de Walkenbach, je trouve
                  toujours des techniques a appronfondir.

                  Joyeuses Fêtes !

                  Amicalement
                  Lupin
                  0
                  1. Novasim220 Auteur
                    Joyeuses fêtes à toi aussi;
                    Expert ou pas,un grand merci pour ton aide.

                    Novasim
                    0