Tri personnalisé - Adapter code pour Excel 2003

Le 24/09/2019 à 15:50

Bonjour cher forum,

J'ai un code pour un tri personnalisé qui fonctionne avec Excel 2010, et j'aimerais en faire profiter un collègue qui est en Excel 2003.

Mais, lorsqu'il tente d'appliquer la procédure, il y a une erreur 438 (propriété non géré par cet objet) sur cette ligne : .Sort.SortFields.Clear

Est-ce possible d'adapter le code pour Excel 2003? Merci

'
'Ulangzx 2019-08-29
'A partir de la ligne 4, trier les données de la manière suivante :
'Colonne A : Tri de A à Z
'Colonne B : Tri personnalisé selon cette liste ("Immeubles éliminés, Mandats donnés au SGPI,Acquisition en cours par SGPI,Propriétés (présentés au CL) en analyse,Propriétés (présentés au CL) en analyse par arrondissement,Propriétés (présentés au CL) en analyse - Contrainte de RDC commercial,Propriétés en analyse,Immeubles intéressants - Notes à réaliser,Immeubles intéressants - Notes à réaliser - Volet 1,Immeubles intéressants - Notes à réaliser - Volet 2,Immeubles intéressants - Notes à réaliser - Volet 3,Immeubles à analyser,(manque liste fournie par arrondissement;+/- 90 terrains à ne pas analyser)
'Redimensionner
'Sauvegarder après usage du bouton Reclasser
'
'
'

Sub Tri()
Dim LastLine&, plage As Range
    'Trier
    With Sheets("Analyse terrains acquisition")
        LastLine = .Range("A" & Rows.Count).End(xlUp).Row
        Set plage = .Range("A4:V" & LastLine)
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("A4:A" & LastLine), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Range("B4:B" & LastLine), SortOn:=xlSortOnValues, _
        Order:=xlAscending, CustomOrder:="Immeubles éliminés, Mandats donnés au SGPI,Acquisition en cours par SGPI,Propriétés (présentés au CL) en analyse,Propriétés (présentés au CL) en analyse par arrondissement,Propriétés (présentés au CL) en analyse - Contrainte de RDC commercial,Propriétés en analyse,Immeubles intéressants - Notes à réaliser,Immeubles intéressants - Notes à réaliser - Volet 1,Immeubles intéressants - Notes à réaliser - Volet 2,Immeubles intéressants - Notes à réaliser - Volet 3,Immeubles à analyser,(manque liste fournie par arrondissement;+/- 90 terrains à ne pas analyser)", DataOption:=xlSortNormal

        With .Sort
            .SetRange plage
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

    'Redimensionner cell,colum
    Cells.EntireRow.AutoFit
    Rows("1:1").RowHeight = 62

    'Sauvegarder
    ActiveWorkbook.Save

End Sub

Le 24/09/2019 à 16:14

Bonjour,

ce serait plus pratique d'avoir un classeur contenant quelques données (non confidentielles) pour réaliser des tests...

A+

Le 24/09/2019 à 16:46

Bonjour AlgoPlus,

Oui, bien sûr.

Merci pour votre aide.

13suivi-analyse-de-terrains-test-tri.zip (77.52 Ko)

Le 25/09/2019 à 03:22

Bonjour,

Une proposition à tester sous Excel 2003.

Cdlt.

Public Sub Tri_2()
Dim ws As Worksheet, lastCol As Long, lastRow As Long, rngData As Range, N As Long
    Set ws = Worksheets("Analyse terrains acquisition")
    Application.AddCustomList _
            listarray:=Array("Immeubles éliminés", _
                             "Mandats donnés au SGPI", _
                             "Acquisition en cours par SGPI", _
                             "Propriétés (présentés au CL) en analyse", _
                             "Propriétés (présentés au CL) en analyse par arrondissement", _
                             "Propriétés (présentés au CL) en analyse - Contrainte de RDC commercial", _
                             "Propriétés en analyse,Immeubles intéressants - Notes à réaliser", _
                             "Immeubles intéressants - Notes à réaliser - Volet 1", _
                             "Immeubles intéressants - Notes à réaliser - Volet 2", _
                             "Immeubles intéressants - Notes à réaliser - Volet 3", _
                             "Immeubles à analyser", _
                             "(manque liste fournie par arrondissement;+/- 90 terrains à ne pas analyser)")
    N = Application.CustomListCount
    With ws
        lastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set rngData = .Cells(3, 1).Resize(lastRow - 2, lastCol)
        rngData.Sort key1:=rngData.Columns(2), _
                     order1:=xlAscending, _
                     Header:=xlYes, _
                     Ordercustom:=Application.CustomListCount + 1
        rngData.Sort key1:=rngData.Columns(1), _
                     order1:=xlAscending, _
                     Header:=xlYes
    End With
    Application.DeleteCustomList listnum:=N
End Sub

Le 26/09/2019 à 17:26

Bonjour Jean-Éric,

Merci pour votre aide. Je vais tester votre proposition sous peu.

Je tente également d'appliquer la même procédure pour un autre tri personnalisé, mais je n'y parviens pas.

J'aimerai avoir un tri personnalisé comme suit:

Trier à partir de la ligne 3 entre les colonne A@Z :

'Colonne B Tri personnalisé selon cette liste ("ACM", "ACL", "MTL")

'Colonne E Tri alpha A@Z

'Colonne D Tri personnalisé selon cette liste ("OC", "ED", "EC", "AP", "EL", "EM")

J'ai essayé avec l'autre procédure, mais le reclassement ne se fait pas à tout coup.

'
'ulangzx 2019-09-26
' Trier à partir de la ligne 3 entre les colonne A@Z, comme suit :
'Colonne B Tri personalisé selon cette liste ("ACM", "ACL", "MTL")
'Colonne E Tri arrondissements alpha A@Z
'Colonne D Tri personalisé selon cette liste ("OC", "ED", "EC", "AP", "EL", "EM")
'
'

Sub Tri()
Dim LastLine&, plage As Range
    'Trier
    With Sheets("AccèsLogis_all")
        LastLine = .Range("A" & Rows.Count).End(xlUp).Row
        Set plage = .Range("A3:Z" & LastLine)
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("B3:B" & LastLine), SortOn:=xlSortOnValues, _
        Order:=xlAscending, CustomOrder:="ACM,ACL,MTL", DataOption:=xlSortNormal

          .Sort.SortFields.Add Key:=Range("D3:D" & LastLine), SortOn:=xlSortOnValues, _
        Order:=xlAscending, CustomOrder:="OC,ED,EC,AP,EL,EM", DataOption:=xlSortNormal

         .Sort.SortFields.Add Key:=Range("E3:E" & LastLine), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

        With .Sort
            .SetRange plage
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

    'Sauvegarder
    'ActiveWorkbook.Save

End Sub

A+

Le 30/09/2019 à 14:57

Bonjour,

désolé, j'avais omis de joindre le fichier.

Merci pour votre aide

8social-liste-des-projets-sociaux-tb-test.xlsm (174.76 Ko)

Le 04/10/2019 à 15:15

Bonjour THE forum,

Petite relance pour mon deuxième tri personnalisé.

J'aimerai avoir un tri personnalisé comme suit:

Trier à partir de la ligne 3 entre les colonne "A:Z", dans l'ordre :

Premier tri, Colonne B Tri personnalisé selon cette liste ("ACM", "ACL", "MTL");

Suivi du tri de la Colonne E, Tri alphabétique ascendant;

Et suivi du tri de la Colonne D, Tri personnalisé selon cette liste ("OC", "ED", "EC", "AP", "EL", "EM")

J'ai essayé avec cette procédure, mais le reclassement ne se fait que partiellement, et pas correctement sur l'ensemble des données.

Merci d'avance pour votre aide.

'
'ulangzx 2019-09-26
' Trier à partir de la ligne 3 entre les colonne A@Z, comme suit :
'Colonne B Tri personalisé selon cette liste ("ACM", "ACL", "MTL")
'Colonne E Tri arrondissements alpha A@Z
'Colonne D Tri personalisé selon cette liste ("OC", "ED", "EC", "AP", "EL", "EM")
'
'

Sub Tri()
Dim LastLine&, plage As Range
    'Trier
    With Sheets("AccèsLogis_all")
        LastLine = .Range("A" & Rows.Count).End(xlUp).Row
        Set plage = .Range("A3:Z" & LastLine)
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("B3:B" & LastLine), SortOn:=xlSortOnValues, _
        Order:=xlAscending, CustomOrder:="ACM,ACL,MTL", DataOption:=xlSortNormal

          .Sort.SortFields.Add Key:=Range("D3:D" & LastLine), SortOn:=xlSortOnValues, _
        Order:=xlAscending, CustomOrder:="OC,ED,EC,AP,EL,EM", DataOption:=xlSortNormal

         .Sort.SortFields.Add Key:=Range("E3:E" & LastLine), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

        With .Sort
            .SetRange plage
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

    'Sauvegarder
    'ActiveWorkbook.Save

End Sub

14social-liste-des-projets-sociaux-tb-test.xlsm (174.76 Ko)

Le 04/10/2019 à 16:59

Bonjour,

j'ai tenté une adaptation de la procédure de Jean-Éric, mais sans succès!

Merci

Public Sub Tri_2()
Dim ws As Worksheet, lastCol As Long, lastRow As Long, rngData As Range, N As Long, O As Long
    Set ws = Worksheets("AccèsLogis_all")

    Application.AddCustomList _
            listarray:=Array("ACM", _
                             "ACL", _
                             "MTL")
    N = Application.CustomListCount

    Application.AddCustomList _
            listarray:=Array("OC", _
                             "ED", _
                             "EC", _
                             "AP", _
                             "EL", _
                             "EM")
    O = Application.CustomListCount

    With ws
        lastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set rngData = .Cells(2, 1).Resize(lastRow - 1, lastCol)
        rngData.Sort key1:=rngData.Columns(2), _
                     order1:=xlAscending, _
                     Header:=xlYes, _
                     Ordercustom:=Application.CustomListCount + 1
        rngData.Sort key1:=rngData.Columns(4), _
                     order1:=xlAscending, _
                     Header:=xlYes, _
                     Ordercustom:=Application.CustomListCount + 1
        rngData.Sort key1:=rngData.Columns(5), _
                     order1:=xlAscending, _
                     Header:=xlYes

    End With
    Application.DeleteCustomList listnum:=N
    Application.DeleteCustomList listnum:=O
End Sub

Le 04/10/2019 à 21:28

Bonjour le forum,

En créant un tri personnalisé, et en l'activant avec l'enregistreur de macro, j'ai obtenu ça.

Ce n'est sans doute pas optimal, mais ça fonctionne pour une plage donnée!

Sub Tri()
'
' Tri Macro
'

'
    ActiveWorkbook.Worksheets("AccèsLogis_all").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("AccèsLogis_all").Sort.SortFields.Add Key:=Range( _
        "B3:B113"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "ACM,ACL,MTL", DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("AccèsLogis_all").Sort.SortFields.Add Key:=Range( _
        "D3:D113"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "OC,ED,EC,AP,EL,EM", DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("AccèsLogis_all").Sort.SortFields.Add Key:=Range( _
        "E3:E113"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal

    With ActiveWorkbook.Worksheets("AccèsLogis_all").Sort
        .SetRange Range("A2:Z113")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub

Bonne fin de semaine

Rechercher des sujets similaires à "tri personnalise adapter code 2003"