Tri colonne A + séparation par une ligne vide

Bonjour,

N'ayant pas trouvé dans la rubrique "RECHERCHE' je me permet de créer un nouveau sujet

J'aimerais avoir une macro qui tri (1)par "LIEU" colonne A, puis qui sépare, par une ligne vide(2), les changements de "LIEU".

exemple ci-dessous

merci

Geoffroy

Bonjour,

Essaie :

Sub Tri()
  Dim I As Long
  Range("A1", Cells(Rows.Count, 1).End(xlUp)).Resize(, 4).Sort [A1], xlAscending, Header:=xlYes
  For I = Cells(Rows.Count, 1).End(xlUp).Row - 1 To 2 Step -1
    If Cells(I, 1) <> Cells(I + 1, 1) Then Cells(I + 1, 1).EntireRow.Insert
  Next I
End Sub

Daniel

Hello à tous,

autre proposition :

Sub ViewClear()
    Dim lngLastRow&, lngTmpRow&
    Dim strPlace$
    With Worksheets("base")
        .Activate
        .Sort.SortFields.Clear
        .Range("a1").CurrentRegion.Sort Key1:=.Range("A1"), Header:=xlYes
        lngLastRow& = .Cells(.Rows.Count, 1).End(xlUp).Row
        lngTmpRow& = 2
        strPlace$ = .Cells(lngTmpRow&, 1).Value
        While Not lngTmpRow& > lngLastRow&
            If .Cells(lngTmpRow&, 1).Value <> strPlace$ Then
                .Rows(lngTmpRow&).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                strPlace$ = .Cells((lngTmpRow& + 1), 1).Value
            End If
            lngTmpRow& = lngTmpRow& + 1
        Wend
    End With
End Sub

Bonjour,

Merci à vous 2 c'est exactement ça

Rapide et efficace

Bravo

Re,

Est-il possible que la macro s'exécute plus rapidement ?

Pour les 2 codes près de 2 minutes pour 481 lignes.

Mais je vais en avoir beaucoup plus

Si non ça fonctionne super bien ...

merci

Re,Re

merci j'ai trouvé pour aller plus vite

A+

Hé ! Dis-nous ce que tu as trouvé. Ca peut resservir !

J'ai pris tes codes sans le tri

pour le tri je me suis servi de l'enregistreur (sûrement à réduire les codes).

j'ai aussi ajouté une ligne pour supprimer les lignes vides si on reclic sur la macro

Le temps d'exécution est de 2 secondes au lieu de 2 minutes pour 481 lignes.

Sub Tri_Entete_Lieu()
'tri la colonne A puis insère une ligne 
' Tri_Entete Macro

Dim I As Long
Dim DernièreLigne As Long
DernièreLigne = ActiveSheet.UsedRange.Row - 1
DernièreLigne = DernièreLigne + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False

Call SupprimerLignes_Vides ' pour éviter d'avoir plusieurs lignes vides au lieu d'1 seule, si on reclic sur la macro 
'
'------------ tri avec l'enregistreur --------------
    ActiveWorkbook.Worksheets("Feuil5").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil5").Sort.SortFields.Add Key:=Range( _
        "A2:A" & DernièreLigne), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil5").Sort
        .SetRange Range("A1:H" & DernièreLigne)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
  '---------------------------------

 '********** Code de DanielC sans le tri ************ insère une ligne
'-------- ligne de tri supprimée ------> Range("c1", Cells(Rows.Count, 1).End(xlUp)).Resize(, 4).Sort [c1], xlAscending, Header:=xlYes
  For I = Cells(Rows.Count, 1).End(xlUp).Row - 1 To 2 Step -1
    If Cells(I, 1) <> Cells(I + 1, 1) Then Cells(I + 1, 1).EntireRow.Insert
  Next I
   '****************
Range("F4").Select
End Sub

A+

Deux minutes ? J'ai testé :

Sub Tri()
  Dim I As Long
  deb = Timer
  Range("A1", Cells(Rows.Count, 1).End(xlUp)).Resize(, 4).Sort [A1], xlAscending, Header:=xlYes
  For I = Cells(Rows.Count, 1).End(xlUp).Row - 1 To 2 Step -1
    If Cells(I, 1) <> Cells(I + 1, 1) Then Cells(I + 1, 1).EntireRow.Insert
  Next I
  Debug.Print Timer - deb
End Sub

Résultat : 0,9453125 sec ?

L'essentiel est que tu sois content...

Daniel

Désolé, je vais revoir peut-être que j'ai une erreur.

Merci

re,

si vous ajoutez aussi ce "Application.ScreenUpdating = False" au début de la macro de DanielC, elle sera plus vite.

La différence = de 0.9s (sans) -----> 0.1s (avec) (Seulement les dixièmes sont significatifs)

Bonjour,

erreur "variable non défini" (deb)

comment se fait-il que vous ça fonctionne?

j'ai mis

  Dim deb As Long

Excelent

merci beaucoup

Bonjour,

erreur "variable non défini" (deb)

comment se fait-il que vous ca fonctionne?

Tu as cette erreur parce que tu as mis (ce qui est recommandé) :

Option Explicit

En tête de ton module. Personnellement, cette option me génère plus d'erreurs qu'elle n''en corrige, aussi, je ne m'en sers pas.

Daniel

Ok

Je l'ai enlevé et ça va super vite

Le code ci-dessous c'est pour indiquer le temps exécution?

Debug.Print Timer - deb

avec excel2007 ça ne fonctionne pas.

A+

Oui. Timer est un compteur de temps. On mesure le temps d'exécution entre le début de la macro (Deb = Timer) et la fin (Timer - Deb). Pour Excel 2007, c'est étonnant, il me semble que je l'utilise depuis toujours (au moins avec Excel 2003). Quel est le message d'erreur ?

bonjour

Ca doit indiquer le temps?

je n'ai rien, aucun message d'erreur, ni message indiquant le temps d'exécution

J'ai ajouté cette ligne pour afficher le temps

MsgBox Timer - deb

Par contre

J'ouvre le fichier lance la macro = 2secondes parfois moins -->quitte sans enregistrer

J'ouvre le fichier + apercu impression + quitter apercu et lance la macro =10secondes

Pourquoi, quand je regarde l'aperçu d'imperssion sans imprimer le temps est plus long?

merci

Le résultat de la commande s'affiche dans la fenêtre exécution de l'éditeur VBA. Pour faire apparaître la fenêtre : Menu Affichage, Fenêtre d'exécution.

Pour l'aperçu avant impression, je regarde tout à l'heure.

Daniel

Ok c'est bon

Le résultat de la commande s'affiche dans la fenêtre exécution de l'éditeur VBA. Pour faire apparaître la fenêtre : Menu Affichage, Fenêtre d'exécution.

ok c'est bon j'ai le temps affiché

merci

Quand l'aperçu avant impression est affiché, ça ne change rien pour moi, toujours 09 sec. De tooute façon, comme l'a indiqué BsAlv, tu as intére^t à ajouter :

Application.ScreenUpdating = False

en début de macro.

Daniel