Microsoft 365 tri alphabétique particulier

C

crown54

XLDnaute Junior
Bonjour à toutes et tous,
je soumets à nouveau une requête aux experts VBA.
J'ai un tableau dont j'aimerai faire un tri par colonne mais pas selon la première lettre, mais selon la lettre située après le point et l'espace qui suit. Ex: A. S; C. W; A. G etc...
Pensez-vous que cela soit possible?
voici le un exemple avec le tableau en question en pj.
La colonne A a des cellules fusionnées donc je souhaite sélectionner à partir de B4 jusque S38 et appliquer cette macro sur la colonne B à l'exception des cellules vides qui doivent rester en place.
Merci beaucoup de votre aide et bonne soirée
 

Pièces jointes

  • macro tri ordre alpha.xlsm
    16.5 KB · Affichages: 8
Trier par date Trier par votes
C

crown54

XLDnaute Junior
Bonjour bsalv,
ton travail est très intéressant merci également.
Je ne comprend pas trop l'histoire de la message box avec les lignes vides si tu peux m'éclairer. ce sont les lignes de séparation B30, 36 et 38 (pour le mois de décembre) par exemple?
J'aimerais que le tri s'applique uniquement sur les lignes entre B3 et B 29 ou 30 selon les mois. Je ne vois pas trop les paramètres à modifier dans ta macro pour y arriver.
ici? Set c = .Range("B4:B37")
merci de ton retour et bonne journée
 
Vote positif 0 Vote négatif
B

bsalv

XLDnaute Occasionnel
comme on arrête à la première ligne grise, ceci est même plus simple.
Si on compare ceci avec @sylvanu dans #7, la méthode est le même mais il ajoute une colonne B au lieu de ma colonne AN et il ne détecte pas la ligne grise.
 

Pièces jointes

  • planning (13).xlsm
    191.7 KB · Affichages: 1
Vote positif 0 Vote négatif
Solution
B

bsalv

XLDnaute Occasionnel
@job75, la 2ième partie de votre macro n'est pas nécessaire, il faut détecter la première ligne grise et la plage n'est que jusque là !
ma macro adaptée, sans vos informations concernant MFCs (??? comme moi, je ne touche pas les plages, no insert, no delete, cela ne change pas, je crois) et autre couleurs
Code: 
Sub Tri_s()
     Dim aA, Vide, c, cGris, sh, t

     t = Timer
     Application.ScreenUpdating = False
     For Each sh In ThisWorkbook.Worksheets
          With sh
               Set c = .Range("B4:B40")      'la plage (+ quelque ligne supplémentaire)
               With Application.FindFormat
                    .Clear
                    .Interior.Color = 8421504     'ce gris spécifique !!!
               End With
               Set cGris = c.Find("", searchFormat:=True)     'première cellule gris dans cette plage

               If cGris Is Nothing Then
                    MsgBox "aucune ligne gris dans colonne B", vbInformation, ActiveSheet.Name
               Else
                    Set c = c.Resize(cGris.Row - c.Row)
                    aA = c.Value             'matrice
                    ReDim Preserve aA(1 To UBound(aA), 1 To 2)     'agrandir à 4 colonnes
                    For i = 1 To UBound(aA)
                         s = Trim(Replace(aA(i, 1), ".", " "))     'split on espaces et points
                         If Len(aA(i, 1)) >= 2 Then     'cellule n'est pas vide
                              aA(i, 2) = Join(Array(Right(s, 1), Left(s, 1)))     'premier et dernier charactère
                         Else
                              MsgBox "problème avec ligne " & i + 3, , sh.Name
                         End If
                    Next

                    With .Range("B4:AM4").Resize(UBound(aA))     'maintenant trier plage initial & plage auxiliaire
                         .MergeCells = False     'no cellules fusionnées !!!
                         .Offset(, .Columns.Count - 1).Resize(, 1).Value = Application.Index(aA, 0, 2)     'la colonne avec les initials inversés
                         .Sort .Cells(1, .Columns.Count), xlAscending, Header:=xlNo     'trier avec cette dernière colonne
                         .Offset(, .Columns.Count - 1).Resize(, 1).ClearContents     'RAZ la colonne avec les initials inversés
                    End With
               End If
          End With
     Next
     MsgBox "prêt"
     'MsgBox Timer - t
End Sub
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Voyez le fichier joint et cette macro :
VB: 
Sub Tri()
'se lance par les touches Ctrl+T
Dim w As Worksheet, dercol%, derlig&, P As Range
Application.ScreenUpdating = False
Workbooks.Add xlWBATWorksheet 'nouveau document auxiliaire
For Each w In ThisWorkbook.Worksheets
    If IsDate("1/" & w.Name) Then
        dercol = w.Cells(1, w.Columns.Count).End(xlToLeft).Column
        derlig = w.Columns(2).Find("", w.Cells(4, 2), xlValues).Row '1ère ligne vide
        Set P = w.Range("B4", w.Cells(derlig, dercol))
        ActiveSheet.Range(P.Address) = P.Value 'copie les valeurs
        With ActiveSheet.Range(P.Address)
            .Columns(2).Insert xlToRight 'insère une colonne auxiliaire
            .Columns(2) = "=TRIM(MID(B4,FIND(""."",B4)+1,99))"
            .Columns(2) = .Columns(2).Value 'supprime les formules
            .Sort .Columns(2), xlAscending, Header:=xlNo 'tri
            .Columns(2).Delete xlToLeft 'supprime la colonne auxiliaire
            P = .Value 'restitue les valeurs
            ActiveSheet.Cells.ClearContents 'RAZ
        End With
    End If
Next w
ActiveWorkbook.Close False 'ferme le document auxiliaire
End Sub
Elle se lance par les touches de raccourci Ctrl+T.

Toutes les feuilles sont triées sur la colonne B jusqu'à la 1ère ligne vide.

J'utilise un document auxiliaire pour que seules les valeurs soient traitées.
 

Pièces jointes

  • planning(1).xlsm
    191.7 KB · Affichages: 2
Vote positif 0 Vote négatif
Phil69970

Phil69970

XLDnaute Barbatruc
Re

@crown54

A priori mon post #14 est invisible
excel-downloads.com

Microsoft 365 - tri alphabétique particulier

Bonjour à toutes et tous, je soumets à nouveau une requête aux experts VBA. J'ai un tableau dont j'aimerai faire un tri par colonne mais pas selon la première lettre, mais selon la lettre située après le point et l'espace qui suit. Ex: A. S; C. W; A. G etc... Pensez-vous que cela soit possible...
excel-downloads.com excel-downloads.com
 
Vote positif 0 Vote négatif
C

crown54

XLDnaute Junior
Phil69970 à dit:
Re

@crown54

A priori mon post #14 est invisible
excel-downloads.com

Microsoft 365 - tri alphabétique particulier

Bonjour à toutes et tous, je soumets à nouveau une requête aux experts VBA. J'ai un tableau dont j'aimerai faire un tri par colonne mais pas selon la première lettre, mais selon la lettre située après le point et l'espace qui suit. Ex: A. S; C. W; A. G etc... Pensez-vous que cela soit possible...
excel-downloads.com excel-downloads.com
Cliquez pour agrandir...
Bonjour Phil,
désolé je n'avais pas vu ta dernière proposition. j'ai regardé mais ça ne fonctionne pas. Je n'ai pas de cellules fusionnées dans la zones d'intérêts. J'ai regardé avec cette macro je n'en ai pas vu. Je me demande donc pourquoi ça ne fonctionne pas.
Les seules cellules fusionnées sont dans la colonne A et il y en aura toujours.
voilà et encore désolé.
Bonne soirée
 
Vote positif 0 Vote négatif
C

crown54

XLDnaute Junior
bsalv à dit:
@job75, la 2ième partie de votre macro n'est pas nécessaire, il faut détecter la première ligne grise et la plage n'est que jusque là !
ma macro adaptée, sans vos informations concernant MFCs (??? comme moi, je ne touche pas les plages, no insert, no delete, cela ne change pas, je crois) et autre couleurs
Code: 
Sub Tri_s()
     Dim aA, Vide, c, cGris, sh, t

     t = Timer
     Application.ScreenUpdating = False
     For Each sh In ThisWorkbook.Worksheets
          With sh
               Set c = .Range("B4:B40")      'la plage (+ quelque ligne supplémentaire)
               With Application.FindFormat
                    .Clear
                    .Interior.Color = 8421504     'ce gris spécifique !!!
               End With
               Set cGris = c.Find("", searchFormat:=True)     'première cellule gris dans cette plage

               If cGris Is Nothing Then
                    MsgBox "aucune ligne gris dans colonne B", vbInformation, ActiveSheet.Name
               Else
                    Set c = c.Resize(cGris.Row - c.Row)
                    aA = c.Value             'matrice
                    ReDim Preserve aA(1 To UBound(aA), 1 To 2)     'agrandir à 4 colonnes
                    For i = 1 To UBound(aA)
                         s = Trim(Replace(aA(i, 1), ".", " "))     'split on espaces et points
                         If Len(aA(i, 1)) >= 2 Then     'cellule n'est pas vide
                              aA(i, 2) = Join(Array(Right(s, 1), Left(s, 1)))     'premier et dernier charactère
                         Else
                              MsgBox "problème avec ligne " & i + 3, , sh.Name
                         End If
                    Next

                    With .Range("B4:AM4").Resize(UBound(aA))     'maintenant trier plage initial & plage auxiliaire
                         .MergeCells = False     'no cellules fusionnées !!!
                         .Offset(, .Columns.Count - 1).Resize(, 1).Value = Application.Index(aA, 0, 2)     'la colonne avec les initials inversés
                         .Sort .Cells(1, .Columns.Count), xlAscending, Header:=xlNo     'trier avec cette dernière colonne
                         .Offset(, .Columns.Count - 1).Resize(, 1).ClearContents     'RAZ la colonne avec les initials inversés
                    End With
               End If
          End With
     Next
     MsgBox "prêt"
     'MsgBox Timer - t
End Sub
Cliquez pour agrandir...
Bonsoir Bsalv,
j'ai encore une petite question. La macro fonctionne très bien sur mon office 365 mais pas sur une version office 2016 :(. Quelle corrections faudraient-il pour que cela fonctionne?
MErci et bonne soirée
Bien cordialement,
 
Vote positif 0 Vote négatif
B

bsalv

XLDnaute Occasionnel
je ne vois pas de problème pour une version 2016, sauf que le gris n'est peut-être pas le "même" gris, donc cette macro recherche la cellule vide B29 ou B30.
Code: 
Sub Tri_s()
     Dim aA, c, cVide, sh, t

     Application.ScreenUpdating = False
     For Each sh In ThisWorkbook.Worksheets
          With sh
               Set c = .Range(.Range("B4"), .Range("B4").End(xlDown))     'la plage commence à B4, jusqu'à la derniere cellule non-vide
               i = c.Rows.Count + c.Row      'numéro de la ligne vide en dessous cette plage
               If i < 29 Or 30 < i Then      'première cellule "vide", c'est B29 ou B30, dépendant du mois !!!)
                    MsgBox "Ligne vide n'est pas 29 ou 30, mais " & i & vbLf & "cette feuille n'est pas triée", vbExclamation, "Feuile : " & sh.Name
               Else
                    aA = c.Value             'matrice
                    ReDim Preserve aA(1 To UBound(aA), 1 To 2)     'agrandir à 4 colonnes
                    For i = 1 To UBound(aA)
                         s = Trim(Replace(aA(i, 1), ".", " "))     'split on espaces et points
                         If Len(aA(i, 1)) >= 2 Then     'cellule n'est pas vide
                              aA(i, 2) = Join(Array(Right(s, 1), Left(s, 1)))     'premier et dernier charactère
                         Else
                              MsgBox "problème avec ligne " & i + 3, , sh.Name
                         End If
                    Next

                    With .Range("B4:AM4").Resize(UBound(aA))     'maintenant trier plage initial & plage auxiliaire
                         .MergeCells = False     'no cellules fusionnées !!!
                         .Offset(, .Columns.Count - 1).Resize(, 1).Value = Application.Index(aA, 0, 2)     'la colonne avec les initials inversés
                         .Sort .Cells(1, .Columns.Count), xlAscending, Header:=xlNo     'trier avec cette dernière colonne
                         .Offset(, .Columns.Count - 1).Resize(, 1).ClearContents     'RAZ la colonne avec les initials inversés
                    End With
               End If
          End With
     Next
     MsgBox "prêt"
End Sub
 
Vote positif 0 Vote négatif
C

crown54

XLDnaute Junior
bsalv à dit:
je ne vois pas de problème pour une version 2016, sauf que le gris n'est peut-être pas le "même" gris, donc cette macro recherche la cellule vide B29 ou B30.
Code: 
Sub Tri_s()
     Dim aA, c, cVide, sh, t

     Application.ScreenUpdating = False
     For Each sh In ThisWorkbook.Worksheets
          With sh
               Set c = .Range(.Range("B4"), .Range("B4").End(xlDown))     'la plage commence à B4, jusqu'à la derniere cellule non-vide
               i = c.Rows.Count + c.Row      'numéro de la ligne vide en dessous cette plage
               If i < 29 Or 30 < i Then      'première cellule "vide", c'est B29 ou B30, dépendant du mois !!!)
                    MsgBox "Ligne vide n'est pas 29 ou 30, mais " & i & vbLf & "cette feuille n'est pas triée", vbExclamation, "Feuile : " & sh.Name
               Else
                    aA = c.Value             'matrice
                    ReDim Preserve aA(1 To UBound(aA), 1 To 2)     'agrandir à 4 colonnes
                    For i = 1 To UBound(aA)
                         s = Trim(Replace(aA(i, 1), ".", " "))     'split on espaces et points
                         If Len(aA(i, 1)) >= 2 Then     'cellule n'est pas vide
                              aA(i, 2) = Join(Array(Right(s, 1), Left(s, 1)))     'premier et dernier charactère
                         Else
                              MsgBox "problème avec ligne " & i + 3, , sh.Name
                         End If
                    Next

                    With .Range("B4:AM4").Resize(UBound(aA))     'maintenant trier plage initial & plage auxiliaire
                         .MergeCells = False     'no cellules fusionnées !!!
                         .Offset(, .Columns.Count - 1).Resize(, 1).Value = Application.Index(aA, 0, 2)     'la colonne avec les initials inversés
                         .Sort .Cells(1, .Columns.Count), xlAscending, Header:=xlNo     'trier avec cette dernière colonne
                         .Offset(, .Columns.Count - 1).Resize(, 1).ClearContents     'RAZ la colonne avec les initials inversés
                    End With
               End If
          End With
     Next
     MsgBox "prêt"
End Sub
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
C

crown54

XLDnaute Junior
Bonsoir bsalv,
le problème se situe à la ligne surlignée de cette macro dans le fichier joint:
erreur d'execution '438':
propriété ou méthode non gérée par cet objet

1691860638579.png


Merci de ta réponse et bonne soirée.
 

Pièces jointes

  • planning (13).xlsm
    192.8 KB · Affichages: 2
Vote positif 0 Vote négatif
B

bsalv

XLDnaute Occasionnel
bonjour, je ne savais pas que c'était cette macro et oui, application.sort n'est pas possible en 2016, seulement à partir de 2021 et 365. Le contournement, c'est d'utiliser une feuille pour ce triage. Vous voulez que je modifie cela, parce que les dernières macros sont plus facile et plus rapide ? on
 
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
XL 2019 Copier une plage dans un fichier fermé en VBA
2
Réponses
21
Affichages
1 K
Amilo
A
Orson83
  • Résolu(e)
XL 2010 Déplacer liste tri validation de données
Réponses
10
Affichages
391
Orson83
Orson83
A
  • Question
Microsoft 365 Répartition de montants dans le temps
Réponses
4
Affichages
329
alphabeta
A
B
  • Question
XL 2019 Problème de tri: alphabétique plutôt que croissant (nombre)
Réponses
4
Affichages
2 K
BobExcel
B
D
  • Résolu(e)
XL 2016 Lier cellules l'un à côté de l'autre
Réponses
6
Affichages
903
Dusam
D
M
  • Question
Microsoft 365 Tri de colonnes avec 3 critères, remplissage de lignes vides avec formule + ventilation vers autre onglet
Réponses
8
Affichages
2 K
marinehaye
M
My<3
  • Question
XL 2019 Bouton pour impression dynamique
Réponses
6
Affichages
528
My<3
My<3
oguruma
POWERQUERY :: Combiner un dossier Excel comportant des fichiers avec des onglets (tableaux structurés) de même structure
Réponses
2
Affichages
287
oguruma
oguruma
O
  • Question
XL 2010 Tri alphabétique sur 2 tableaux
Réponses
7
Affichages
879
chris
chris
B
  • Résolu(e)
XL 2016 assembler plusieurs formules en une
Réponses
5
Affichages
1 K
Bullrot
B

Membres actuellement en ligne

17 membres et 145 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 207
Messages
2 086 232
Membres
103 161
dernier inscrit
Rogombe bryan