Tri croissant 2 criteres

Bonsoir,

Je m'en remet a votre expertise de faisabilité

J'ai deux colonnes In et Out que je veux trié l'un par rapport à l'autre selon la valeur situé après le "-"

ci-joint un exemple pour meilleur compréhension

à Savoir que la colonne In et Out peuvent comporter des milliers de ligne et que l'affichage du résultats ne doit pas affectés

les autres colonnes du classeur

Bien respectueusement votre

Bonsoir barachoie,

Un essai en VBA sous forme de procédure avec trois paramètres:

Sub TriSpecial(PlageIn As Range, PlageOut As Range, Destination As Range)

• PlageIn est un range qui référence la plage des valeurs de IN (sans l'en-tête)
  Plageout est un range qui référence la plage des valeurs de OUT (sans l'en-tête)
  Destination est un range qui référence la cellule de destination

Le code de TriSpecial est dans le module Module1

Un exemple d'utilisation d'appel de la procédure TriSpecial est dans le module de code de Feuil1. Cliquez sur le bouton Hop!

ATTENTION!

Le code de la version v1 précédemment joint comportait une erreur. J'ai donc remplacé la v1 par la v2. Le pourquoi de l'erreur figure dans le message #5 de ce fil.

MaPoire c'est du grand Art !!!!!

Avec une telle facilité de surcroit

Chapeau vraiment Chapeau !!!!

Belle réalisation

MERCI

Bonsoir,

Salut MaPoire !

Décidément je suis tes traces ! (et encore au retour d'une consultation !)

Barachoie : autre méthode !

Sub TriInOut(plIn As Range, plOut As Range, dest As Range)
    Dim TIO(), TIn, TOut, k, i%, j%, m&, n&
    With plIn
        TIn = Range(.Cells(2, 1), .Cells(1, 1).End(xlDown)).Value
    End With
    For i = 1 To UBound(TIn) - 1
        For j = i + 1 To UBound(TIn)
            If CLng(Split(TIn(j, 1), "-")(1)) < CLng(Split(TIn(i, 1), "-")(1)) Then
                k = TIn(j, 1): TIn(j, 1) = TIn(i, 1): TIn(i, 1) = k
            End If
        Next j
    Next i
    With plOut
        TOut = Range(.Cells(2, 1), .Cells(1, 1).End(xlDown)).Value
    End With
    For i = 1 To UBound(TOut) - 1
        For j = i + 1 To UBound(TOut)
            If CLng(Split(TOut(j, 1), "-")(1)) < CLng(Split(TOut(i, 1), "-")(1)) Then
                k = TOut(j, 1): TOut(j, 1) = TOut(i, 1): TOut(i, 1) = k
            End If
        Next j
    Next i
    ReDim TIO(1, UBound(TIn) + UBound(TOut)): k = 0: i = 1: j = 1
    m = CLng(Split(TIn(i, 1), "-")(1)): n = CLng(Split(TOut(j, 1), "-")(1))
    Do
        k = k + 1
        If m = n Then
            TIO(0, k) = TIn(i, 1): TIO(1, k) = TOut(j, 1)
            i = i + 1: j = j + 1
            If i <= UBound(TIn) Then m = CLng(Split(TIn(i, 1), "-")(1)) Else m = 9 ^ 9
            If j <= UBound(TOut) Then n = CLng(Split(TOut(j, 1), "-")(1)) Else n = 9 ^ 9
        ElseIf m < n Then
            TIO(0, k) = TIn(i, 1): i = i + 1
            If i <= UBound(TIn) Then m = CLng(Split(TIn(i, 1), "-")(1)) Else m = 9 ^ 9
        Else
            TIO(1, k) = TOut(j, 1): j = j + 1
            If j <= UBound(TOut) Then n = CLng(Split(TOut(j, 1), "-")(1)) Else n = 9 ^ 9
        End If
    Loop Until m = 9 ^ 9 And n = 9 ^ 9
    ReDim Preserve TIO(1, k)
    TIO(0, 0) = "TRI IN": TIO(1, 0) = "TRI OUT"
    dest.Resize(k + 1, 2).Value = WorksheetFunction.Transpose(TIO)
End Sub

Clique sur ta flèche pour tester. J'ai pas fait la mise en forme...

Cordialement.

Bonsoir barachoie, MFferrand

Depuis ma première réponse, il y a quelque chose qui me chiffonnait dans le code de mon fichier v1.

Après avoir relu encore et encore le code , j'ai trouvé une faute logique aussi grosse que moi

Dans la ligne de code de la v1:

If ptr1 < UBound(tIN) Then

il faut remplacer "<" par "<=" ce qui donne:

If ptr1 <= UBound(tIN) Then

Si on ne fait pas la correction, alors si la liste IN contient le max des nombres, les éléments de IN qui correspondent à ce max ne sont pas pris en compte.

Bonsoir MaPoire, Barachoie, MFerrand

En cas de doublons, comment doit s'opérer l'alignement, je ne comprends pas la logique

Ici, doublons dans la colonne Out

Chapeau pour vos 2 solutions

klin89

Bonsoir,

Pour ma part, ils restent dans l'ordre où ils étaient... Le tri est fait sur les valeurs après le tiret en tant que nombres (pour le cas où le nombre de ces caractères numériques augmenterait ou diminuerait, ici ces 'nombres' étant tous à 4 caractères cela n'avait pas d'incidence...). Si on veut un tri incluant la partie avant tiret, il conviendrait de trier les 2 listes préalablement. Je ne l'ai pas inclus car il semblait y avoir un classement particulier que je n'ai pas voulu déranger, mais le cas échéant on peut l'introduire !

Cordialement.

Merci infiniment pour vos Soluces car c'est Moteur et instructifs

Dans le cas ou j'aurai à Trié qu'une seule colonne y aurait t'il une petite macro que je pourrait mettre en call

ou que l'on pourrait inclure dans la première?

Merci à Tous !!!!!!!

Merci infiniment pour vos Soluces car c'est Moteur et instructifs

"En cas de DOUBLON" la solution initial me convenez car pas de Doublon a remonter mais uniquement le xxxxx-XXXX

comme valeur Unique meme s'il apparaît plusieurs fois

Dans le cas ou j'aurai à Trié qu'une seule colonne y aurait t'il une petite macro que je pourrait mettre en call

ou que l'on pourrait inclure dans la première?

Merci à Tous !!!!!!!

Bonjour,

Proposition d'aménagement :

1) On étoffe la procédure de lancement, qui demandera à l'utilisateur de définir les plages : IN à trier (la cellule d'en-tête), OUT à trier (la cellule d'en-tête), destination du Tri (la cellule supérieure gauche) :

Sub LanceTri()
    Dim plIn As Range, plOut As Range, dest As Range, pld%
    On Error Resume Next
    Set plIn = Application.InputBox("Sélectionner la cellule d'en-tête de la liste 'IN'," _
     & " ou cliquer sur 'Annuler'.", "Sélection plage 'IN' à trier", Type:=8)
    Set plOut = Application.InputBox("Sélectionner la cellule d'en-tête de la liste 'OUT'," _
     & " ou cliquer sur 'Annuler'.", "Sélection plage 'OUT' à trier", Type:=8)
    If Not plIn Is Nothing Then pld = 1
    If Not plOut Is Nothing Then pld = pld + 2
    Set dest = Application.InputBox("Sélectionner la cellule supérieure gauche de la plage " _
     & "de destination du tri. Obligatoire si le tri concerne 'IN' et 'OUT', sinon 'Annuler'" _
     & "entraînera un tri 'IN' ou 'OUT' sur place !", "Sélection plage de destination du tri", _
     Type:=8)
    If dest Is Nothing Then
        Select Case pld
            Case 1: Set dest = plIn
            Case 2: Set dest = plOut
            Case 3: Exit Sub
        End Select
    End If
    TriInOut plIn, plOut, dest
End Sub

L'utilisateur peut définir la plage IN et annuler pour OUT : seule IN sera triée.

L'inverse : annuler IN et définir OUT : seule OUT sera triée.

Si aucun des deux n'est définie, tout s'interrompt.

Pour la plage destination : si seule IN ou seule OUT est définie, il peut ne pas la définir (annuler) et le tri se fera alors sur place.

Si les deux sont définies, la définition de la plage destination devient obligatoire, si elle n'est pas opérée la procédure s'interrompt.

Aménagements de la procédure de Tri :

Sub TriInOut(plIn As Range, plOut As Range, dest As Range)
    Dim TIO(), TIn, TOut, k, i%, j%, m&, n&
    If Not plIn Is Nothing Then
        With plIn
            TIn = Range(.Cells(2, 1), .Cells(1, 1).End(xlDown)).Value
        End With
        For i = 1 To UBound(TIn) - 1
            For j = i + 1 To UBound(TIn)
                If CLng(Split(TIn(j, 1), "-")(1)) < CLng(Split(TIn(i, 1), "-")(1)) Then
                    k = TIn(j, 1): TIn(j, 1) = TIn(i, 1): TIn(i, 1) = k
                End If
            Next j
        Next i
    End If
    If Not plOut Is Nothing Then
        With plOut
            TOut = Range(.Cells(2, 1), .Cells(1, 1).End(xlDown)).Value
        End With
        For i = 1 To UBound(TOut) - 1
            For j = i + 1 To UBound(TOut)
                If CLng(Split(TOut(j, 1), "-")(1)) < CLng(Split(TOut(i, 1), "-")(1)) Then
                    k = TOut(j, 1): TOut(j, 1) = TOut(i, 1): TOut(i, 1) = k
                End If
            Next j
        Next i
    End If
    If plOut Is Nothing Then
        dest = "TRI IN"
        dest.Cells(2, 1).Resize(UBound(TIn)).Value = TIn: Exit Sub
    End If
    If plIn Is Nothing Then
        dest = "TRI OUT"
        dest.Cells(2, 1).Resize(UBound(TOut)).Value = TOut: Exit Sub
    End If
    ReDim TIO(1, UBound(TIn) + UBound(TOut)): k = 0: i = 1: j = 1
    m = CLng(Split(TIn(i, 1), "-")(1)): n = CLng(Split(TOut(j, 1), "-")(1))
    Do
        k = k + 1
        If m = n Then
            TIO(0, k) = TIn(i, 1): TIO(1, k) = TOut(j, 1)
            i = i + 1: j = j + 1
            If i <= UBound(TIn) Then m = CLng(Split(TIn(i, 1), "-")(1)) Else m = 9 ^ 9
            If j <= UBound(TOut) Then n = CLng(Split(TOut(j, 1), "-")(1)) Else n = 9 ^ 9
        ElseIf m < n Then
            TIO(0, k) = TIn(i, 1): i = i + 1
            If i <= UBound(TIn) Then m = CLng(Split(TIn(i, 1), "-")(1)) Else m = 9 ^ 9
        Else
            TIO(1, k) = TOut(j, 1): j = j + 1
            If j <= UBound(TOut) Then n = CLng(Split(TOut(j, 1), "-")(1)) Else n = 9 ^ 9
        End If
    Loop Until m = 9 ^ 9 And n = 9 ^ 9
    ReDim Preserve TIO(1, k)
    TIO(0, 0) = "TRI IN": TIO(1, 0) = "TRI OUT"
    dest.Resize(k + 1, 2).Value = WorksheetFunction.Transpose(TIO)
End Sub

Elle n'est pas modifiée dans son déroulement antérieur qui consistait à sortir chaque plage à trier en tableau et à le trier séparément selon les spécifications... On met donc juste cette opération sous condition que la plage est définie.

A l'issue, si seule l'une des deux plages est définie, ce que l'on teste tour à tour, le tri est déjà fait, il qu'à l'affecter à la plage de destination, et s'arrêter. Si les deux sont définies, cela se poursuit comme auparavant.

Cordialement.

Merci

C vraiment une très bonne idée car cela devient interactif au libre choix de l'utilisateur

Bravo et encore Merci

Bien cordialement