Sujet Précédent Sujet Suivant

Tri automatique

Novasim220 Messages postés 15 Statut Membre -  
Novasim220 Messages postés 15 Statut Membre -
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

Réponse 1 / 11
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
Novasim220 Messages postés 15 Statut Membre
 
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
Réponse 2 / 11
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
Réponse 3 / 11
Lupin
 
re : 

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


Lupin
0
Réponse 4 / 11
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
Novasim220 Messages postés 15 Statut Membre
 
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

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 11
Novasim220 Messages postés 15 Statut Membre
 
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
Réponse 6 / 11
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
Réponse 7 / 11
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
Réponse 8 / 11
Novasim220 Messages postés 15 Statut Membre
 
Salut Lupin,
vais essayer tout çà dans la matinée et te tiens au courant
Sympa de ta part,
Merci encore @+
0
Réponse 9 / 11
Novasim220 Messages postés 15 Statut Membre
 
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
Réponse 10 / 11
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
Réponse 11 / 11
Novasim220 Messages postés 15 Statut Membre
 
Joyeuses fêtes à toi aussi;
Expert ou pas,un grand merci pour ton aide.

Novasim
0