tri de cellules en gras

[diiity]

Bonjour,

Je suis débutant et je voudrais trier des cellules qui sont écrites en gras.
En faites, j'ai une colonne avec des noms qui sont placés par ordre alphabétique et au fur et à mesure de leurs utilisations, je les met en gras.
Seulement au moment de rechercher un nom qui n'est pas en gras j'ai un peu de mal.
J'aimerais donc pouvoir faire un tri qui me rassemble les mon en gras d'un coté et les noms qui ne le sont pas de l'autre, ou mieux dés que le nom est en gras il passe dans la colonne approprié mais là c'est peut être plus compliqué?

merci pour votre aide

diiity

 

[MJ13]

Re : tri de cellules en gras

Bonjour Diiity

Pourrais-tu joindre ton fichier STP.

Ainsi un XLDien pourra plus facilement te répondre.

Par contre je n'aurais pas le temps ce Week-end .

 

[diiity]

Re : tri de cellules en gras

Bonjour Diiity

Pourrais-tu joindre ton fichier STP.

Ainsi un XLDien pourra plus facilement te répondre.

Par contre je n'aurais pas le temps ce Week-end .

Bonjour,
Bien voici
diiity

 

[Paritec]

Re : tri de cellules en gras

Bonjour Michel

ou mieux dés que le nom est en gras il passe dans la colonne approprié mais là

Et la colonne appropriée elle est ou ? Et la colonne à coté elle est liée au nom ??
Aucunes explications dans le fichier!!
a+
Papou

 

[job75]

Re : tri de cellules en gras

Bonjour diiity, Michel, Papou,

Voyez le fichier joint avec la feuille d'extraction.

La macro dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Activate()
Dim r As Range, tablo(), n As Long
Set r = Sheets("Base").Range("A:A,E:E,I:I").SpecialCells(xlCellTypeConstants)
For Each r In r
  If r.Font.Bold Then 'si gras
    ReDim Preserve tablo(1, n) 'tableau transposé
    tablo(0, n) = r
    tablo(1, n) = r.Offset(, 1)
    n = n + 1
  End If
Next
Me.[A2:B65536].ClearContents 'RAZ
If n Then Me.[A2:B2].Resize(n) = Application.Transpose(tablo)
End Sub

Avec un tableau évolutif, seule la dernière dimension peut être redimensionnée.

A+

 

[mapomme]

Re : tri de cellules en gras

Bonjour Diity et salut aux autres,

Une autre version. Cliquez sur le bouton. Le code est dans module1. Modifier la constante sColonneData = "A;E;I" pour l'ajuster à votre feuille.
Comme "ou mieux dés que le nom est en gras il passe dans la colonne approprié" ne m'inspirait pas, les communes en gras sont rassemblées en bas des trois tableaux.

Option Explicit
Const sColonneData = "A;E;I"

Sub GrasEnBas()

Dim ColonneData
Dim nFinLig, xcol, i, j, aux
Dim LigGras, LigPasGras
Dim xRg As Range

Application.ScreenUpdating = False
Sheets("Feuil3").Select
' Transformer la chaine de caractères en tableau
ColonneData = Split(sColonneData, ";")
'boucle sur les colonnes des communes
For Each xcol In ColonneData
    ' recherche du numéro de la dernière ligne de la colonne
    nFinLig = Range(xcol & Rows.Count).End(xlUp).Row
    'on insère une colonne à gauche
    Columns(xcol & ":" & xcol).Insert Shift:=xlToRight
    'On y met la formule retournant l'état (gras ou non)
    Range(xcol & "1:" & xcol & nFinLig).FormulaR1C1 = "=EnGrasVF(RC[1])"
    ' passage en valeur
    Range(xcol & "1:" & xcol & nFinLig).FormulaR1C1 = Range(xcol & "1:" & xcol & nFinLig).Value
    'définition de la plage des 3 colonnes à trier
    Set xRg = Range(xcol & "1:" & xcol & nFinLig).Resize(, 3)
    ' tri des 3 colonnes
    xRg.Sort key1:=xRg(1, 1), order1:=xlAscending, key2:=xRg(1, 2), order2:=xlAscending, Header:=xlNo
    ' suppression de la colonne insérée
    Columns(xcol & ":" & xcol).Delete Shift:=xlToLeft
Next xcol
Application.ScreenUpdating = True
End Sub

Function EnGrasVF(xCellule As Range) As String
    EnGrasVF = xCellule.Font.Bold
End Function

 

[DoubleZero]

Re : tri de cellules en gras

Bonjour, le Fil, le Forum,

Comme je le dis souvent... le ridicule ne tue pas !

Voici, par conséquent, ma petite contribution :

Sub Gras()
Dim i As Long
Application.ScreenUpdating = False
    For i = Sheets("Feuil3").Range("a65536").End(xlUp).Row To 1 Step -1
        If Range("a" & i).Font.Bold = True Then Rows(i).Cut Destination:=Sheets("Gras").Range("A65536").End(xlUp)(2)
        If Range("a" & i) = "" = True Then Rows(i).Delete
    Next
    With Sheets("Gras")
        .Activate
        .Range("A:A").Sort Range("A2"), xlAscending, Header:=xlYes
    End With
Application.ScreenUpdating = True
End Sub

A bientôt

 

[job75]

Re : tri de cellules en gras

Re, salut mapomme et DoubleZero

On peut aussi utiliser 2 feuilles d'extraction, fichier (2).

A+

 

[mapomme]

Re : tri de cellules en gras

(re)Bonjour diiity et bonjour à DoubleZero, Job75 et Paritec,

Ou bien pour déplacer (commune+CP) de deux cellules à droite si la commune est en gras.

Edit: ou bien en les déplaçant à droite et en les regroupant en haut => version 3

Option Explicit
Const sColonneData = "A;E;I"

Sub GrasAcote()
Dim ColonneData, xcol, i

'Application.ScreenUpdating = False
Sheets("Feuil3").Select
' Transformer la chaine de caractères en tableau
ColonneData = Split(sColonneData, ";")
'boucle sur les colonnes des communes
For Each xcol In ColonneData
    i = 1
    'Boucle sur les lignes
    Do Until Trim(Range(xcol & i)) = ""
        If Range(xcol & i).Font.Bold Then
            'la commune est en gras => on la déplace
            Range(xcol & i).Resize(, 2).Cut Destination:=Range(xcol & i).Resize(, 2).Offset(, 2)
        End If
        i = i + 1
    Loop
Next xcol
Application.ScreenUpdating = True
End Sub

 

[diiity]

Re : tri de cellules en gras

Bonjour à tous,

Je ne sais quoi dire à part WAOUH!!! vraiment impressionnant, pour moi débutant, de voir autant d'aide en si peu de temps et toutes plus intéressantes les unes que les autres.

Une petite correction à ma demande, j'aurais voulu que les colonnes non gras et gras soit sur la même feuille.

Encore un grand merci à tous

diiity

 

[job75]

Re : tri de cellules en gras

Re,

(...) j'aurais voulu que les colonnes non gras et gras soit sur la même feuille.

Oui c'est mieux, alors voilà :

Private Sub Worksheet_Activate()
Dim r As Range, tablo1(), n1 As Long, tablo2(), n2 As Long
Set r = Sheets("Base").Range("A:A,E:E,I:I").SpecialCells(xlCellTypeConstants)
For Each r In r
  If r.Font.Bold Then 'si gras
    ReDim Preserve tablo1(1, n1) 'tableau transposé
    tablo1(0, n1) = r
    tablo1(1, n1) = r.Offset(, 1)
    n1 = n1 + 1
  Else
    ReDim Preserve tablo2(1, n2) 'tableau transposé
    tablo2(0, n2) = r
    tablo2(1, n2) = r.Offset(, 1)
    n2 = n2 + 1
  End If
Next
Application.ScreenUpdating = False
Me.[A2:D65536].ClearContents 'RAZ
If n1 Then Me.[A2:B2].Resize(n1) = Application.Transpose(tablo1)
If n2 Then Me.[C2:D2].Resize(n2) = Application.Transpose(tablo2)
End Sub

Fichier (3).

Edit : mieux avec Application.ScreenUpdating = False

A+

 

[mapomme]

Re : tri de cellules en gras

(re)Bonjour,

j'aurais voulu que les colonnes non gras et gras soit sur la même feuille

voir aussi https://www.excel-downloads.com/threads/tri-de-cellules-en-gras.179846/ si ça peux te convenir mais aucune nouvelle feuille n'est crée, ce qui peut être génant si on veut conserver la feuille initiale en l'état.

 

[diiity]

Re : tri de cellules en gras

SUPER, encore un GRAND MERCI
diiity