Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 tri alphabétique particulier

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

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
 

crown54

XLDnaute Junior
Merci Bsalv,
avec 2-3 petites adaptations cela fonctionne très bien!!!!
Trop cool.
Merci à tous pour vos propositions et encore désolé de ne pas avoir mis le fichier final dès le début.
j'en prend bonne note pour la prochaine fois.
 

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

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
 

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

crown54

XLDnaute Junior
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
 

crown54

XLDnaute Junior
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,
 

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
 

crown54

XLDnaute Junior
 

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



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

Pièces jointes

  • planning (13).xlsm
    192.8 KB · Affichages: 2

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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…