Barre de progression

[red-69]

Bonjour à tous,

Dans un tableau excel de 15000 lignes, j'ai une macro pour créer un nouvel onglet à chaque fois qu'un élément nouveau apparaît dans la colonne B.
Les onglets sont ensuite triés par ordre alphabétique.

Tout cela fonctionne parfaitement. Mon problème c'est que ce traitement est très long (environ 5 minutes).
Je voudrais savoir si quelqu'un pouvais m'aider à créer une barre de progression à insérer dans ma macro pour avertir l'utilisateur du déroulement des opérations.

Cdlt

Voici la macro :

Option Explicit

Public Sub Tri_par_nom()
' en fonction de la valeur de la colonne B
' création d'une feuille avec nom colonne B
' autres colonnes documentant les cellules concernées
Dim W1 As Worksheet ' feuille base
Dim W2 As Worksheet ' feuille client
Dim lig As Long ' ligne traitée
Dim feu As Object ' feuille présente
Dim ong As Integer ' numèro feuille

Set W1 = Sheets("Suivi général") ' position feuille base
Application.ScreenUpdating = False

For Each feu In Sheets ' suppression feuilles
If feu.Name <> W1.Name Then
Application.DisplayAlerts = False
feu.Delete
Application.DisplayAlerts = True
End If
Next feu

' création des feuilles client
For lig = 10 To W1.Cells(15000, 20).End(xlUp).Row

For ong = 1 To Sheets.Count ' test existance feuille
If Sheets(ong).Name = UCase(W1.Cells(lig, 21).Text) Then
Set W2 = Sheets(ong)
Exit For
End If

Next ong
If ong > Sheets.Count Then
For ong = 2 To Sheets.Count ' tri feuille

If Sheets(ong).Name > UCase(W1.Cells(lig, 21).Text) Then Exit For
Next ong ' création feuille

Sheets.Add(After:=Sheets(ong - 1)).Name = UCase(W1.Cells(lig, 21).Text)
Set W2 = ActiveSheet
W1.Rows("1:9").Copy Destination:=W2.Rows("1:9") ' ajout titre

End If
W1.Rows(lig).Copy Destination:=W2.Rows(W2.Cells(65536, 2).End(xlUp).Row + 1) ' ajout ligne traitée
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Next lig
W1.Activate
Application.ScreenUpdating = True


End Sub

 

[pierrejean]

Re : Barre de progression

bonjour red-69

Je parierais bien
1) que ta macro peut s'accelerer notoirement
2) qu'une barre de progression ne fera surtout que la ralentir

Comme il est assez indigeste de comprendre une macro que l'on n'a pas ecrite peux-tu nous poster un fichier exemple de ce que tu souhaites (quelques lignes et colonnes suffisent (sans données confidentielles)

 

[kjin]

Re : Barre de progression

Bonjour,
Salut pierrejean , tu as trouvé les mots que je cherchais
A+
kjin

 

[red-69]

Re : Barre de progression

Bonjour pierrejean et kjin, merci de vous penchez sur mon problème.

Comme demandé, voici un exemple de l'utilisation de la macro.
Merci

 

[cocotier]

Re : Barre de progression

c'est normal que ton execution est long...
(tu suprime tous les feuille a chaque fois puis de reconstitue...)
il vaux mieux les garder puis reinfecter l'ordre.
(ex tu marque tout -> affiche dans l'ordre, de ton trie. pour le trie le plus facile rapide est de trier ta conlonne B ( paris, Marceille...) puis appeler l'onglet en function du mon. N'oublie pas le count de ligne B = count ong si oui... ça va , sinon tu dois refaire la recherche ExisteOnglet ...) comme ça tu diminimum de 60% de la capacite du script.
bien à toi

 

[kjin]

Re : Barre de progression

Re,
A tester et adapter (les lignes 1 à 9 à voir)
Chez moi 2,7s pour 37000 lignes

Sub Tri_par_nom()
For Each ws In ActiveWorkbook.Sheets
    Application.DisplayAlerts = False
    If ws.Name <> ActiveSheet.Name Then ws.Delete
    Application.DisplayAlerts = True
Next
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Range("U10:U" & Range("U65000").End(xlUp).Row)
    If Not d.exists(cel.Value) Then d.Add cel.Value, cel.Value
Next
Tbl = d.items
For i = 0 To UBound(Tbl)
    x = i
    For k = x + 1 To UBound(Tbl)
        If Tbl(k) <= Tbl(x) Then x = k
    Next k
    If i <> x Then
    y = Tbl(x): Tbl(x) = Tbl(i): Tbl(i) = y
    End If
Next i
Application.ScreenUpdating = False
For i = 0 To UBound(Tbl)
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = Tbl(i)
    With Sheets("Suivi général")
        .Rows("1:9").Copy ActiveSheet.Range("A1") 'est on obligé de tout copier ?
        .Range("A9").AutoFilter Field:=21, Criteria1:=Tbl(i)
        Set fplage = .AutoFilter.Range
        fplage.Copy ActiveSheet.Range("A9")
        .AutoFilterMode = False
    End With
    ActiveSheet.Columns.AutoFit
Next
Application.ScreenUpdating = True

End Sub

A+
kjin

 

[red-69]

Re : Barre de progression

Effectivement, c'est extrêmement plus efficace !!
Moins de 3 secondes!

J'ai encore des progrès à faire en programmation !!

Merci

 

[cocotier]

Re : Barre de progression

salut !! ton code semble juste mais elle ralenti pas mal car excel = haute plaforme donc assez lourd. Tu ecrase toutes tes feuille et les reconstitue en copant toute les données.. = inutile.
il suffit de contourner un pet excel soit:
compare le count colonne 20 avec count sheet
ajoute la feuille manquant avec ses donnees
hide toutes tes onglets sauf le principal
facultatif (tu trie uniquement ta colonne 20 (paris, mars....) dans une autre colonne temporaire)
réafficher toutes les feuilles (onglet) ou celles que tu desire.
tu va gagner min 50% de plus du temps
bien à toi

 

[cocotier]

Re : Barre de progression

salut !! ton code semble juste mais elle ralenti pas mal car excel = haute plaforme donc assez lourd. Tu ecrase toutes tes feuille et les reconstitue en copant toute les données.. = inutile.
il suffit de contourner un pet excel soit:
compare le count colonne 20 avec count sheet
ajoute la feuille manquant avec ses donnees
hide toutes tes onglets sauf le principal
facultatif (tu trie uniquement ta colonne 20 (paris, mars....) dans une autre colonne temporaire)
réafficher toutes les feuilles (onglet) ou celles que tu desire.
tu va gagner min 50% de plus du temps

bien à toi