Microsoft 365 Tris spéciaux

Usine à gaz · 26 Septembre 2021

Bonjour à toutes et à tous,
Je vous souhaite une belle fin de dimanche

Je voudrais faire des tris spéciaux.
Par exemple :

Prospect 1

22550 MATIGNON 1 rue excel-downloads

Trié sur 22550 ou MATIGNON (remarque IMPORTANTE : 22550 et MATIGNON sont dans la même cellule)
Cela me ferait économiser des colonnes ainsi que de la taille fichier.

J'ai tenté et fait des recherches mais je n'y suis pas arrivé.
D'ailleurs, est-ce possible ?
Si oui, auriez-vous le bon code ?
Je joins un petit fichier test.

Avec mes remerciements,
Je continue mes recherches.
Amicalement,
lionel

job75 · 26 Septembre 2021

Bonsoir Lionel,

Les codes des 2 boutons :

VB:

Sub Tri_CP()
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
    .Columns(.Columns.Count + 1).Resize(, 2).Insert xlToRight '2 colonnes auxiliaires
    With .Columns(.Columns.Count + 1)
        .FormulaR1C1 = "=LEFT(RC[-1],FIND("" "",RC[-1])-1)"
        .Offset(, 1).FormulaR1C1 = "=MID(RC[-2],FIND("" "",RC[-2])+1,999)"
        .EntireRow.Sort .Cells, xlAscending, .Cells(1, 2), , xlAscending, Header:=xlYes
        .Resize(, 2).Delete xlToLeft 'supprime les colonnes auxiliaires
    End With
End With
End Sub

Sub Tri_Ville()
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
    .Columns(.Columns.Count + 1).Resize(, 2).Insert xlToRight '2 colonnes auxiliaires
    With...

job75 · 26 Septembre 2021

Bonsoir Lionel,

Les codes des 2 boutons :

VB:

Sub Tri_CP()
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
    .Columns(.Columns.Count + 1).Resize(, 2).Insert xlToRight '2 colonnes auxiliaires
    With .Columns(.Columns.Count + 1)
        .FormulaR1C1 = "=LEFT(RC[-1],FIND("" "",RC[-1])-1)"
        .Offset(, 1).FormulaR1C1 = "=MID(RC[-2],FIND("" "",RC[-2])+1,999)"
        .EntireRow.Sort .Cells, xlAscending, .Cells(1, 2), , xlAscending, Header:=xlYes
        .Resize(, 2).Delete xlToLeft 'supprime les colonnes auxiliaires
    End With
End With
End Sub

Sub Tri_Ville()
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
    .Columns(.Columns.Count + 1).Resize(, 2).Insert xlToRight '2 colonnes auxiliaires
    With .Columns(.Columns.Count + 1)
        .FormulaR1C1 = "=LEFT(RC[-1],FIND("" "",RC[-1])-1)"
        .Offset(, 1).FormulaR1C1 = "=MID(RC[-2],FIND("" "",RC[-2])+1,999)"
        .EntireRow.Sort .Cells(1, 2), xlAscending, .Cells, , xlAscending, Header:=xlYes
        .Resize(, 2).Delete xlToLeft 'supprime les colonnes auxiliaires
    End With
End With
End Sub

A+

Usine à gaz · 26 Septembre 2021

Ha ! Gérard Bonsoir, toujours là et magique
Je regarde et je reviens mais je me doute du résultat.
lionel,

Usine à gaz · 26 Septembre 2021

ha que Génial : Comme dirait Johnny
Merci Gérard, c'est super !
Fallait le trouver celui-là !!!
Bonne fin de dimanche,
lionel

Usine à gaz · 26 Septembre 2021

lol, j'oubliais : Bonsoir Gérard

Faudra que je relise la charte lol

Microsoft 365 Tris spéciaux

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

job75

job75

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Discussions similaires