XL 2013 Trouver nom plage de la cellule active et trier la plage de cellule

JULIEN.PATRICK

XLDnaute Nouveau
Bonjour à tous,

Voici mon problème sur lequel je suis depuis plusieurs jours ....

Je souhaiterais trouver le nom de la plage de cellule dans laquelle se trouve la cellule active et ensuite trier cette plage de cellule nommée en partant de la première colonne de cette même plage.
le but étant de trier par ordre alpha la plage de cellule nommée ou est positionné la cellule active .

Je suis complétement perdu et je ne suis pas sûr que cela soit possible, mais si vous aviez un début de réponse je suis preneur .


Par avance merci
 

Dudu2

XLDnaute Barbatruc
Bonjour,

Un essai...
VB:
Sub Test()
    Dim NomPlage As String
   
    NomPlage = NomPlageCelluleActive
    If Len(NomPlage) > 0 Then Call TrierPlage(NomPlage)
End Sub

'----------------------------------------------------------
'Retourne le 1er nom du Gestionnaire de noms qui représente
'une plage dans laquelle se trouve la cellule active
'----------------------------------------------------------
Function NomPlageCelluleActive() As String
    Dim Nom As Name
    Dim Rng As Range
   
    On Error Resume Next
   
    'Liste des noms
    For Each Nom In ThisWorkbook.Names
        Set Rng = Range(Nom)
       
        If Err.Number Then
            Err.Clear
        Else
            If ActiveCell.Parent.Name = Rng.Parent.Name Then
                If Not Intersect(ActiveCell, Rng) Is Nothing Then Exit For
            End If
        End If
    Next Nom
   
    On Error GoTo 0
    If Not Nom Is Nothing Then NomPlageCelluleActive = Nom.Name
End Function
   
'--------------------------------------------
'Trie la plage nommée sur la colonne indiquée
'--------------------------------------------
Sub TrierPlage(NomPlage As String, Optional NoColonne As Integer = 1)
    Dim Rng As Range
   
    Set Rng = Range(NomPlage)
   
    With Rng.Parent.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Rng.Columns(NoColonne), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Rng
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
 
Dernière édition:

fanch55

XLDnaute Barbatruc
Bonjour à tous,
A mettre dans le code de la feuille et à tester :
  • Ne trie pas les zones nommées non contiguës
  • Trie une zone horizontale sur une ligne
  • Trie une zone verticale sur une colonne
  • Trie une zone multi-lignes et multi-colonnes de gauche à droite en revenant à la ligne.
VB:
Sub test()
Dim Plage   As Range
Dim Nm      As Name
    ' On vérifie si la cellule fait partie d'un des noms de la feuille
    For Each Nm In Me.Names
        If Not Intersect(Range(Nm.RefersTo), ActiveCell) Is Nothing Then
            Set Plage = Range(Nm.RefersTo)
            Exit For
        End If
    Next
    
    ' Sinon On vérifie si la cellule fait partie d'un des noms du classeur
    If Plage Is Nothing Then
        For Each Nm In ThisWorkbook.Names
            If Not Intersect(Range(Nm.RefersTo), ActiveCell) Is Nothing Then
                Set Plage = Range(Nm.RefersTo)
                Exit For
            End If
        Next
    End If
    
    ' Si on a trouvé la plage, on la trie
    Select Case True
        Case Plage Is Nothing: ' Rien à faire
        Case Plage.Areas.Count > 1: MsgBox "les champs non contigus ne sont pas pris en charge", vbCritical
        Case Plage.Rows.Count > 1 And Plage.Columns.Count > 1:
            Dim T()
            ReDim T(Plage.Cells.Count - 1)
            For I = 0 To Plage.Cells.Count - 1 ' On charge les cellules dans un tableau simple
                T(I) = Plage.Cells(I + 1)
            Next
                For I = 0 To UBound(T) ' On trie ce tableau par ordre croissant
                    x = I
                    For k = x + 1 To UBound(T)
                        If T(k) <= T(x) Then x = k
                    Next k
                    If I <> x Then
                        ValTemp = T(x)
                        T(x) = T(I)
                        T(I) = ValTemp
                    End If
                Next I
            For I = 0 To Plage.Cells.Count - 1 ' On recharge le tableau dans la plage
                Plage.Cells(I + 1) = T(I)
            Next
        Case Else
            ' 1 colonne ou 1 ligne, on utilise les fonctions excel
            With Me.Sort
                .SortFields.Clear
                .SortFields.Add Key:=Plage, _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange Plage
                .Header = xlNo
                .MatchCase = False
                .Orientation = IIf(Plage.Rows.Count = 1, xlLeftToRight, xlTopToBottom)
                .SortMethod = xlPinYin
                .Apply
            End With
    End Select
    

End Sub
 

gbinforme

XLDnaute Impliqué
Bonjour à tous,

trier cette plage de cellule nommée en partant de la première colonne de cette même plage.

C'est ce que fait ce code succinct que je te propose :
VB:
Public Sub tri_plage()
Dim nms As Name
    For Each nms In ActiveWorkbook.Names
        If Not Intersect(Range(ActiveCell.Address), Range(Mid(nms.RefersTo, 2))) Is Nothing Then
            With ActiveWorkbook.ActiveSheet.Sort
                With .SortFields
                    .Clear
                    .Add Key:=Range(nms.Name).Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                End With
                .SetRange Range(nms.Name)
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End If
    Next nms
End Sub
 

Dudu2

XLDnaute Barbatruc
Bonsoir @fanch55, @gbinforme

Attention ! Code Review ;)
1 - Tous les noms ne font pas forcément référence à des plages et si ce n'est pas le cas évidemment Range(Nm.RefersTo) se plante.

2 - Si le Range issu d'un Range(Nm.RefersTo) n'appartient pas à la même feuille que l'ActiveCell,
Intersect(Range(Nm.RefersTo), ActiveCell) ne rend pas Nothing mais se plante bel et bien.

Voici un fichier de test pour le vérifier.

@fanch55, tu testes les Ranges Multi-Areas c'est une précaution intéressante. Pour information Range(Nom) où Nom fait référence à un Range Multi-Areas part en erreur comme quand Nom ne fait pas référence à un Range.
Et je ne vois pas bien la justification de tes manips sur Me (code feuille à dupliquer pour toutes les feuilles) puis sur le Workbook et le tri VBA intégré.
 

Pièces jointes

  • Classeur4.xlsm
    27.1 KB · Affichages: 9
Dernière édition:

fanch55

XLDnaute Barbatruc
Bonsoir @Dudu2,
Bon, code pondu rapidement, destiné à être dans la feuille active ( par flemme ) d'où les Me.
Je suis d'abord parti pour ne traiter qu'une ligne ou colonne d'où le tri via excel ( je n'ai aucune notion du type de range que veut trier @JULIEN.PATRICK )
Il est vrai que celui-ci n'est plus nécessaire avec le tri par tableau .
Pour les names, c'est vrai, pas assez rigoureux avec ceux qui ne concernent pas des ranges .
Le code ci-dessous devrait résoudre toutes tes remarques :
VB:
Sub testfanch55()
Dim Plage   As Range
Dim Nm      As Name
    ' On vérifie si la cellule fait partie d'un des noms de la feuille
    On Error Resume Next
    For Each Nm In Worksheets(1).Names
        If Not Intersect(ActiveSheet.Range(Nm.RefersTo), ActiveCell) Is Nothing Then
            If Err = 0 Then ' car le nom peut ne pas être un range
                Set Plage = ActiveSheet.Range(Nm.RefersTo)
                Exit For
            Else
                Err.Clear
            End If
        End If
    Next
   
    ' Sinon On vérifie si la cellule fait partie d'un des noms du classeur
    If Plage Is Nothing Then
        On Error Resume Next
        For Each Nm In ThisWorkbook.Names
            If Not Intersect(ActiveSheet.Range(Nm.RefersTo), ActiveCell) Is Nothing Then
                If Err = 0 Then ' car le nom peut ne pas être un range
                    Set Plage = ActiveSheet.Range(Nm.RefersTo)
                    Exit For
                Else
                    Err.Clear
                End If
            End If
        Next
    End If
   
    ' Si on a trouvé la plage, on la trie
    Select Case True
        Case Plage Is Nothing: ' Rien à faire
        Case Plage.Areas.Count > 1: MsgBox "les champs non contigus ne sont pas pris en charge", vbCritical
'        Case Plage.Rows.Count > 1 And Plage.Columns.Count > 1:
        Case Else
            Dim T()
            ReDim T(Plage.Cells.Count - 1)
            For I = 0 To Plage.Cells.Count - 1 ' On charge les cellules dans un tableau simple
                T(I) = Plage.Cells(I + 1)
            Next
                For I = 0 To UBound(T) ' On trie ce tableau par ordre croissant
                    x = I
                    For k = x + 1 To UBound(T)
                        If T(k) <= T(x) Then x = k
                    Next k
                    If I <> x Then
                        ValTemp = T(x)
                        T(x) = T(I)
                        T(I) = ValTemp
                    End If
                Next I
            For I = 0 To Plage.Cells.Count - 1 ' On recharge le tableau dans la plage
                Plage.Cells(I + 1) = T(I)
            Next
    End Select
   

End Sub

Il y a également un cas non traité : si une cellule fait partie de plusieurs noms ...
 
Dernière édition:

JULIEN.PATRICK

XLDnaute Nouveau
Bonjour
Et merci à tous pour votre aide et le temps passé.
je suis navré mais j'ai quelques soucis a mettre en place le code de fanch55.
j'ai du mal m'exprimer ,car en faite je souhaiterais que le tri se fasse par rapport aux données de la colonne 1 de la plage nommée qui est sous forme de tableau.
Et il faudrait que je puisse répéter cette opération plusieurs fois d'affilé, ce qui' n'est pas de cas chez moi.
je joins un fichier pour plus de simplicité
Encore désolé de vous solliciter et encore merci.
 

Pièces jointes

  • exemple1.xls
    60 KB · Affichages: 8

chris

XLDnaute Barbatruc
Bonjour à tous

Il faut toujours donner le contexte ou un exemple afin qu'on ne parte pas sur de fausses pistes...

C'est un non sens d'utiliser le format xls pour gérer des tableaux structurés...

Depuis 2007, les tableaux ont un nom, inutile de redéfinir une plage nommée

Dans le module de la feuille

VB:
Sub tri()
    If ActiveCell.ListObject Is Nothing Then Exit Sub
    With ActiveCell.ListObject
    .Sort.SortFields.Clear
    .Sort.SortFields.Add2 Key:=.ListColumns(1).Range, _
        SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortTextAsNumbers
        With .Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .Apply
        End With
    End With
End Sub

Si cela doit se limiter à un tableau parmi les 4 ajouter un if au début du module après le 1er
Par exemple
Code:
    If ActiveCell.ListObject.Name <> "Test25" Then Exit Sub
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
Bonjour,
C'est sûr ! En tous cas ça m'a fait plaisir de participer !
1629613716288.gif
 

patricktoulon

XLDnaute Barbatruc
Bonjour
VB:
Sub test()
    MsgBox GetNameOfRangeWithOneCell()
End Sub

Function GetNameOfRangeWithOneCell(Optional cel As Range = Nothing)
       If cel Is Nothing Then Set cel = ActiveCell
    On Error Resume Next
    Nom = cel.ListObject.Name
    If Err > 0 Then
        Nom = "No Name!!"
        For Each n In Names
            If Not Intersect(Range(n), cel) Is Nothing Then Nom = n.Name
        Next
    End If
    GetNameOfRangeWithOneCell = Nom
End Function
 

fanch55

XLDnaute Barbatruc
Bonjour à tous,
Ah ben si j'avais su que c'était des tableaux structurés !!! 😩
@chris , j'aurai ajouté au tri avant le dernier end with
VB:
    .Sort.SortFields.Clear
    .DataBodyRange.AutoFilter
mais je chipote ... 🥳

Sinon, il me semble que @JULIEN.PATRICK utilise Excel 2013,
en ce cas il faut remplacer sortfields.add2 par sortfields.add
 

chris

XLDnaute Barbatruc
RE
OK bien sûr pour sortfields.add qui fonctionne sur toutes versions

.Sort.SortFields.Clear étant prévu au début et le tri n'ayant rien de particulier, pas sûr de l'utilité

.DataBodyRange.AutoFilter pourquoi pas mais dans ce cas il faudrait tester l'état au début pou savoir si on l'active ou le désactive...
 

fanch55

XLDnaute Barbatruc
RE
OK bien sûr pour sortfields.add qui fonctionne sur toutes versions

.Sort.SortFields.Clear étant prévu au début et le tri n'ayant rien de particulier, pas sûr de l'utilité

.DataBodyRange.AutoFilter pourquoi pas mais dans ce cas il faudrait tester l'état au début pou savoir si on l'active ou le désactive...
Quand j'impose un filtre par code,
j'ai toujours l'habitude de "nettoyer" l'affichage du tri en cours
( d'accord avec toi, pas sûr de l'utilité ... à voir avec le "Customer Design")

pour le 2nd, c'est vrai et je donne ton code modifié pour @JULIEN.PATRICK si cela l’intéresse ...
VB:
Sub tri()
    If Not ActiveCell.ListObject Is Nothing Then
        With ActiveCell.ListObject
            ShowFilter = .ShowAutoFilter
            With .Sort
                .SortFields.Clear
                .SortFields.Add2 Key:=.Parent.ListColumns(1).Range, _
                        SortOn:=xlSortOnValues, Order:=xlAscending, _
                        DataOption:=xlSortTextAsNumbers ' ou .add
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
                .SortFields.Clear ' ou pas
            End With
            If Not ShowFilter And .ShowAutoFilter Then .DataBodyRange.AutoFilter
        End With
    End If
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
314 663
Messages
2 111 662
Membres
111 250
dernier inscrit
alinber