Microsoft 365 tri alphabétique particulier

[crown54]

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

 

[bsalv]

voilà le technique, en 365 (et en 2021?), on sait trier (avec 1 clé, donc les cas moins compliqués) un vecteur en mémoire, donc c'est plus rapide.

Dans les 2 macros ici dessous, c'est la partie au milieu qui est important, le reste est démonstration. Dans l'exemple et en 365 avec un vecteur en mémoire, on trie la 3ième colonne descendant et le résultat est un nouveau vecteur avec seulement une ligne. Si on n'a pas cette version, on doit trier physiquement (ici dans une feuille temporaire) et lire le résultat vers un vecteur en 10 lignes.

Sub Trier_365()
     Dim aA, aB
   
     With Range("A1").CurrentRegion          'cette plage
          .FormulaR1C1 = "=rand()"           'des valeurs aléatoire
          .Value = .Value                    'remplacer formules par valeurs
          aA = .Value                        'lire vers mémoire

          aB = Application.Sort(aA, 3, -1)   'trier la 3ième colonne de aA "descendant", le résultat est vecteur aB

          'normallement cela s'arrête ici
          'cette ligne est pour vous montrer le résultat
          .Offset(, .Columns.Count + 2).Value = aB     'coller vecteur aB à droite
     End With

End Sub

Sub Trier_Contournement_2016()
     Dim aA, aB
   
     With Range("A1").CurrentRegion          'cette plage
          .FormulaR1C1 = "=rand()"           'des valeurs aléatoire
          .Value = .Value                    'remplacer formules par valeurs
          aA = .Value                        'lire vers mémoire

          With Worksheets.Add                'ajouter une feuille temporairement pour le triage
               With .Range("A1").Resize(UBound(aA), UBound(aA, 2))     'plage avec les mêmes dimensions
                    .Value = aA              'coller votre vecteur
                    .Sort .Cells(1, 3), xlDescending, Header:=xlNo    'trier physiquement
                    aB = .Value              'lire le résultat
               End With
               Application.DisplayAlerts = False
               .Delete                       'supprimer la feuille temporaire
               Application.DisplayAlerts = True
          End With

          'normallement cela s'arrête ici
          'cette ligne est pour vous montrer le résultat
          .Offset(, .Columns.Count + 2).Value = aB     'coller vecteur aB à droite
     End With

End Sub

 

[crown54]

merci beaucoup bsalv. Je vais tester la semaine prochaine.
Bon dimanche