Microsoft 365 tri alphabétique particulier

Phil69970 à dit:

Re

@crown54

A priori mon post #14 est invisible

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

Cliquez pour agrandir...

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...

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...