XL 2019 Classer en ordre alphabétique plusieurs colonnes

[Bsm]

Bonjour à tous,
Je suis retraité et débutant. je vais essayer d'être clair.
J'ai un classeur contenant une liste de titres de films contenu dans 3 colonnes (A,B et C) avec 1 ligne d'entête toutes les 80 lignes.
Quand je saisi un nouveau titre, je passe 10mn à déplacer les titres afin d'y insérer dans l'ordre alphabétique le nouveau titre.
Ma question donc, est t'il possible de saisir à la fin de la colonne ayant une cellule de libre le titre puis trier automatiquement
cela ?
L'ordre de tri du classeur se fait ainsi :
A1 jusqu'à A80 puis B1 jusqu'à B80 puis C1 jusqu'à C80
ensuite pour la seconde page (imprimée) :
A82 jusqu'à A160 puis B82 jusqu'à B160 puis C82 jusqu'à C160
et ainsi de suite pour d'autres page à venir.

Merci de votre aide, je vous joint le fichier cela pourra peut être être plus parlant*
Merci William

 

[Gégé-45550]

Bonjour à tous,
Je suis retraité et débutant. je vais essayer d'être clair.
J'ai un classeur contenant une liste de titres de films contenu dans 3 colonnes (A,B et C) avec 1 ligne d'entête toutes les 80 lignes.
Quand je saisi un nouveau titre, je passe 10mn à déplacer les titres afin d'y insérer dans l'ordre alphabétique le nouveau titre.
Ma question donc, est t'il possible de saisir à la fin de la colonne ayant une cellule de libre le titre puis trier automatiquement
cela ?
L'ordre de tri du classeur se fait ainsi :
A1 jusqu'à A80 puis B1 jusqu'à B80 puis C1 jusqu'à C80
ensuite pour la seconde page (imprimée) :
A82 jusqu'à A160 puis B82 jusqu'à B160 puis C82 jusqu'à C160
et ainsi de suite pour d'autres page à venir.

Merci de votre aide, je vous joint le fichier cela pourra peut être être plus parlant*
Merci William

Bonsoir,
Une suggestion (voir Feuil2 du fichier joint) :

• utiliser un tableau structuré
• (option) figer la première ligne du tableau de façon à toujours voir le titre
• après chaque ajout dans la première ligne vide en bas du tableau, cliquer sur la flèche à droite de la cellule A1 et sélectionner "trier de A à Z" et le tri alpha sera automatique
• les résultats sont affichés en Feuil2(2)

Cordialement,

 

[job75]

Bonjour Bsm, Gégé-45550, le forum,

Un tableau structuré ne paraît pas une bonne idée puisqu'en fait il y a plusieurs tableaux.

Voyez le fichier joint et ces macros dans le code de la feuille :

Option Compare Text 'la casse est ignorée

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim pas&, tablo, j%, i&, a(), n&, ub&
Cancel = True
pas = 80
With Range("A" & 1 + pas * Int((Target.Row - 1) / pas), "C" & pas + pas * Int((Target.Row - 1) / pas))
    tablo = .Value 'matrice, plus rapide
    For j = 1 To 3
        For i = 2 To pas
            If tablo(i, j) <> "" Then
                ReDim Preserve a(n)
                a(n) = tablo(i, j)
                n = n + 1
            End If
    Next i, j
    ub = UBound(a)
    tri a, 0, ub
    n = 0
    For j = 1 To 3
        For i = 2 To pas
            If n <= ub Then tablo(i, j) = a(n) Else tablo(i, j) = ""
            n = n + 1
    Next i, j
    .Value = tablo 'restitution
End With
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

Double-clic dans le tableau à trier.

A+

 

[Gégé-45550]

Bonjour Bsm, Gégé-45550, le forum,

Un tableau structuré ne paraît pas une bonne idée puisqu'en fait il y a plusieurs tableaux.

Voyez le fichier joint et ces macros dans le code de la feuille :

Option Compare Text 'la casse est ignorée

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim pas&, tablo, j%, i&, a(), n&, ub&
Cancel = True
pas = 80
With Range("A" & 1 + pas * Int((Target.Row - 1) / pas), "C" & pas + pas * Int((Target.Row - 1) / pas))
    tablo = .Value 'matrice, plus rapide
    For j = 1 To 3
        For i = 2 To pas
            If tablo(i, j) <> "" Then
                ReDim Preserve a(n)
                a(n) = tablo(i, j)
                n = n + 1
            End If
    Next i, j
    ub = UBound(a)
    tri a, 0, ub
    n = 0
    For j = 1 To 3
        For i = 2 To pas
            If n <= ub Then tablo(i, j) = a(n) Else tablo(i, j) = ""
            n = n + 1
    Next i, j
    .Value = tablo 'restitution
End With
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

Double-clic dans le tableau à trier.

A+

Bonjour @job75,
Mais si, un tableau structuré fonctionne parfaitement (voir PJ modifiée du #2) et il permet d'éviter le VBA.
Cordialement,

 

[Bsm]

Je vais regarder votre travail
Je vous remercie à tous de votre aide
William

 

[Bsm]

Merci beaucoup de votre travail à tous les deux.
Je suis plus attiré par le tableau structuré de Gégé-45550 par rapport à la macro de Job75, d'une je n'y connais rien en vba et de deux je n'obtient pas le résultat attendu, c'est à dire que si un titre est rajouté dans la "seconde section", il sera trié pour cette section et non pour l'ensemble du tableau ( ou alors je fait mal).
J'ai essayé de passer vite fait le pas de 80 à 160, cela fonctionne sur tout le tableau mais hélas les lignes d'entêtes contiennent des titres et à chaque double clic le listing perd une ligne ??
Merci en tout cas de vous êtes donnés la peine de m'aider, je garde votre fichier à tous les deux pour explorer tout cela.
Cordialement, William

 

[Gégé-45550]

Merci beaucoup de votre travail à tous les deux.
Je suis plus attiré par le tableau structuré de Gégé-45550 par rapport à la macro de Job75, d'une je n'y connais rien en vba et de deux je n'obtient pas le résultat attendu, c'est à dire que si un titre est rajouté dans la "seconde section", il sera trié pour cette section et non pour l'ensemble du tableau ( ou alors je fait mal).
J'ai essayé de passer vite fait le pas de 80 à 160, cela fonctionne sur tout le tableau mais hélas les lignes d'entêtes contiennent des titres et à chaque double clic le listing perd une ligne ??
Merci en tout cas de vous êtes donnés la peine de m'aider, je garde votre fichier à tous les deux pour explorer tout cela.
Cordialement, William

Re
Si une réponse vous convient, merci de la marquer comme "SOLUTION' en cliquant sur la coche verte dans le bandeau à droite de celle-ci.
Cordialement,

 

[job75]

et de deux je n'obtient pas le résultat attendu, c'est à dire que si un titre est rajouté dans la "seconde section", il sera trié pour cette section et non pour l'ensemble du tableau

Oui au temps pour moi, j'avais mal compris le problème.

 

[job75]

Voyez ce fichier (2) avec le code corrigé :

Option Compare Text 'la casse est ignorée

Sub Trier()
'se lance par le raccourci clavier Ctrl+T
Dim pas&, tablo, j%, i&, a(), n&, ub&, deb As Range
pas = 80
tablo = [A1].CurrentRegion.Resize(, 3) 'matrice, plus rapide
For j = 1 To 3
    For i = 2 To UBound(tablo)
        If tablo(i, j) <> "" And i <> 1 + pas * Int(i / pas) Then
            ReDim Preserve a(n)
            a(n) = tablo(i, j)
            n = n + 1
        End If
Next i, j
ub = UBound(a)
tri a, 0, ub
n = 0
'---restitutions---
Set deb = [A1]
While deb <> ""
    tablo = deb.Resize(pas, 3)
    For j = 1 To 3
        For i = 2 To pas
            If n <= ub Then tablo(i, j) = a(n) Else tablo(i, j) = ""
            n = n + 1
    Next i, j
    deb.Resize(pas, 3) = tablo
    Set deb = deb.Offset(pas) 'tableau suivant
Wend
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

Touches Ctrl+T pour lancer la macro