comment découper une liste dans différents onglets

[bolem]

Bonjour

Je pensais retrouver cela en cherchant mais je suis un très mauvais chercheur...
Je souhaite découper une liste en différents onglets.
Dans le fichier exemple, il y a 3 colonnes
prénom, code, adresse

Je voudrais pouvoir répartir toutes les lignes sur différents onglets suivant le code.
Chaque onglet aurait donc comme nom le code et on retrouverait les lignes entières de la liste dans chaque onglet

Deux possibilités :
en connaissant les différentes possibilités du code (nombre fini de cas) ou en ne connaissant pas a priori les cas

merci d'avance

Olivier

 

[david84]

Re : comment découper une liste dans différents onglets

Un ordinateur correct sans plus :

 

[BOISGONTIER]

Re : comment découper une liste dans différents onglets

Bonjour,

>Cela laisse supposer que le tri préalable soit effectivement la solution la plus rapide.

Les tests le prouvent (post #22)

>Après il y a peut-être moyen de réduire le temps de traitement pour ventiler les blocs constitués sans passer par un dictionnaire ou une double boucle.

Le temps pris par la gestion des boucles ne représente que 3% du temps global. Gagner 50% sur 3% ferait gagner 1,5% sur le temps global, ce qui est dérisoire.

JB

 

[ROGER2327]

Re : comment découper une liste dans différents onglets

Bonjour à tous.

J'ai été intrigué par les résultats annoncés par david84 (#29), donnant Essai plus rapide que Extrait. Résultats que je confirme.

En cherchant bien, je me suis rendu compte que la différence ne provenait pas essentiellement du choix de la technique de détermination de la dimension des blocs de données ("dictionnaire" vs "procédure Do... Loop").
La différence provient de la façon de créer la feuille annexe pour ordonner les codes.​

Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Données").[A1].CurrentRegion.Copy [A1]

est nettement plus rapide que​

Sheets("Données").Copy Before:=Sheets(1)

lorsqu'il y a beaucoup de données.

En reprenant la tactique de david84 pour l'injecter dans le code de BOISGONTIER, ce code reprend l'avantage.

L'écart reste cependant faible : 10,8s contre 12s pour un million d’enregistrements ventilés dans vingt onglets.
Lorsqu'il y a peu d'enregistrements, Essai peut reprendre l'avantage. Par exemple 1,7s contre 1,3s avec 32 000 enregistrements ventilés sur 200 onglets. C'est négligeable en pratique.

Personnellement, je me rallie au principe de BOISGONTIER, avec l'utilisation de la tactique de david84 pour le transfert des données dans la feuille auxiliaire.

En pièce jointe, le résultats de mes élucubrations...​

Bonne soirée. Mollo sur le Beaujolais...


ℝOGER2327
#8108

Mardi 17 As 143 (Saint Pangloss, humoriste passif - fête Suprême Quarte)
28 Brumaire An CCXXIV, 6,2311h - coing
2015-W47-4T14:57:17Z

 

[BOISGONTIER]

Re : comment découper une liste dans différents onglets

Bonjour,

Qq essais supplémentaires:

-Copie de feuille (64.000 lignes):

0,28 sec et 0,21 sec

Sub CopyFeuille1()
  t = Timer
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Sheets("BD").Copy Before:=Sheets(1)
  MsgBox Timer - t     ' 0,28 s
End Sub

Sub CopyFeuille2()
  t = Timer
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Sheets.Add Before:=Sheets(1)
  Sheets("BD").[A1].CurrentRegion.Copy [A1]
  MsgBox Timer - t      ' 0,21 s
End Sub

Création Dico: 0,35 sec

Sub CréaDico()
    t = Timer
    Set f = Sheets(1)
    Ncol = 3
    ColCritère = 2
    Derlig = f.[a65000].End(xlUp).Row
    Set Rng = f.Cells(2, 1).Resize(Derlig, Ncol)
    Tblcrit = f.Cells(2, ColCritère).Resize(Derlig - 1)
    Set d = CreateObject("scripting.dictionary")
    For i = 1 To UBound(Tblcrit)
      d(Tblcrit(i, 1)) = d(Tblcrit(i, 1)) + 1
    Next i
    MsgBox Timer - t
End Sub

Programme Final:

Pour 64.000 lignes: 1,02 sec (1,16 sec pour ESSAI de DAVID)

Remarques:
-Il n'est pas sûr que la restitution de la BD dans son état initial soit nécessaire (Le but étant d'extraire des onglets). En supprimant cette contrainte, le gain est de 0,22 sec)
-Lors des tests de temps, une macro exécutée plusieurs fois peut donner des temps sensiblement différents

Sub Extrait2()
  t = Timer
  Dim i&, Premier&, Ncol&, ColCritère&, n&
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Sheets.Add Before:=Sheets(1)
  Sheets("BD").[A1].CurrentRegion.Copy [A1]
  Set f = Sheets(1)
  Ncol = 3                ' Adapter ou Ncol=f.[A1].CurrentRegion.Columns.Count
  ColCritère = 2          ' adapter
  Derlig = f.[a65000].End(xlUp).Row
  Set Rng = f.Cells(2, 1).Resize(Derlig, Ncol)
  With f.Sort
     .SortFields.Clear
     .SortFields.Add Key:=Rng.Columns(ColCritère), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
     .SetRange Rng
     .Header = xlNo
     .Apply
  End With
  TblCrit = f.Cells(2, ColCritère).Resize(Derlig - 1)
  i = 1: Premier = 1
  n = UBound(TblCrit)
  Do While i <= n
    code = TblCrit(i, 1)
    Do While TblCrit(i, 1) = code
      i = i + 1: If i > n Then Exit Do
    Loop
    On Error Resume Next: Sheets(code).Delete: On Error GoTo 0
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = code
    f.Cells(1 + Premier, 1).Resize(i - Premier, Ncol).Copy [A2]
    f.Cells(1, 1).Resize(, Ncol).Copy [A1]
    Premier = i
  Loop
  Sheets(1).Delete
  MsgBox Timer() - t
End Sub

Le fichier joint ne contient que 32.000 lignes (taille de PJ)

EDIT: Corrigé erreur tri signalée par Roger

JB

 

[ROGER2327]

Re : comment découper une liste dans différents onglets

Re...

(...)
Tri :

Suivant la syntaxe on obtient des temps de 0,70sec et 0,35 sec

(...)

Il me semble que Tri2 n'ordonne que la deuxième colonne.​

(...)
-Lors des tests de temps, une macro exécutée plusieurs fois peut donner des temps sensiblement différents

(...)

Oui, malheureusement. On est obligé de les répéter cinq ou dix fois. Si les variations sont importantes entre les essais, on ne peut guère en tirer de certitude...​

Bonne journée.



ℝOGER2327
#8109

Mercredi 18 As 143 (Saint Chambernac, pauvriseur - fête Suprême Quarte)
29 Brumaire An CCXXIV, 4,8922h - cormier
2015-W47-5T11:44:29Z

 

[gosselien]

Re : comment découper une liste dans différents onglets

Bonjour le forum et tous les excellents contributeurs à ce fil ,

ces codes sont excessivement rapides mais la machine (j'en avais parlé plus avant) est aussi importante je pense, la RAM et la fréquence du (des) processeurs peuvent changer bcp de choses.
Evidemment les tests de vitesse se faisant sur le même pc, chacun pourra mesurer les grosses différences
Mais 64.000 lignes en moins d'une seconde ,pas de quoi se plaindre pour l'utilisateur final de ce post

(Vivement mon iMac 3,9 Ghz ) pour remplacer mon vieil ACER 2.0 Ghz si le père noel m'entends
Ce genre de post est des plus intéressant et merci à vous de l'alimenter !!!

 

[ROGER2327]

Re : comment découper une liste dans différents onglets

Re...

(...)
ces codes sont excessivement rapides mais la machine (j'en avais parlé plus avant) est aussi importante je pense, la RAM et la fréquence du (des) processeurs peuvent changer bcp de choses.
(...)

D'accord. Pour information, mes tests sont effectués sur une machine portable alimentée par le secteur et dotée de ces caractéristiques :

Regarde la pièce jointe 953037.​

Bonne journée.


ℝOGER2327
#8110

Mercredi 18 As 143 (Saint Chambernac, pauvriseur - fête Suprême Quarte)
29 Brumaire An CCXXIV, 5,8660h - cormier
2015-W47-5T14:04:42Z

 

[david84]

Re : comment découper une liste dans différents onglets

Bonjour,

intéressants tous ces tests !

Je n'aurais pas cru que la "tactique" de création de feuille ait une incidence si importante.

Concernant le mode de tri je suis passé par un SortFields car le Sort simple ne donnait pas chez moi le résultat voulu lorsque je testais sur le fichier de Roger-un régal ce fichier test !- car certains codes n'étaient pas correctement triés. En utilisant

DataOption:=xlSortTextAsNumbers

cela me réglait le problème. Alors tant mieux s'il est plus rapide mais cette méthode ne peut être utilisée qu'à partir de la version 2007 (donc à voir).

Ceci dit si l'on veut comparer les codes ces derniers doivent remplir le même cahier des charges : le mien ventile à la mode "rustique" avec un report des entêtes "en dur", une gestion d'erreur plus que sommaire et des cas de figure non prévus tels que l'existence possible de l'onglet, etc. Et ces traitements prennent inévitablement du temps.

Essai remanié pourrait donner ceci (c'est plus lent mais plus souple d'utilisation) :

Sub Essai2()
Dim R As Range, Rcode As Range, d As Object, tCode, i&, dk, di, pl&, Dlig&, Plig&, NbCol&
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Temp"
Sheets("Données").Cells(1, 1).CurrentRegion.Copy Sheets("temp").Cells(1, 1)
Set R = Sheets("temp").Cells(1, 1).CurrentRegion
NbCol = R.Columns.Count

With Worksheets("Temp").Sort
  .SortFields.Clear
  .SortFields.Add Key:=R.Columns(2) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
  .SetRange R 'suite à la remarque de Roger
  .Header = xlYes
  .Apply
End With

Sheets("temp").Rows(1).Delete

Set Rcode = R.Columns(2)
tCode = Rcode
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(tCode): d(CStr(tCode(i, 1))) = d(CStr(tCode(i, 1))) + 1: Next
dk = d.Keys: di = d.Items
ReDim Preserve di(UBound(di) + 1)

Plig = 1: Dlig = di(0)

For i = 0 To UBound(dk)
  On Error Resume Next: Sheets(dk(i)).Delete: On Error GoTo 0
  Sheets.Add After:=Sheets(Sheets.Count)
  ActiveSheet.Name = dk(i)
   
  With Sheets(dk(i))
    Sheets("Données").Cells(1, 1).Resize(1, NbCol).Copy .Cells(1, 1)
    Sheets("temp").Cells(Plig, 1).Resize(Dlig - Plig + 1, NbCol).Copy .Cells(2, 1)
  End With
 
  Plig = Dlig + 1: Dlig = Dlig + di(i + 1)
Next i

Sheets("temp").Delete
Application.ScreenUpdating = True: Application.DisplayAlerts = True
End Sub

A priori le fait de passer par un Resize

Sheets("temp").Cells(Plig, 1).Resize(Dlig - Plig + 1, NbCol).Copy .Cells(2, 1)

ne prend pas plus de temps que la syntaxe

Sheets("temp").Range(Sheets("temp").Cells(Plig, 1), Sheets("temp").Cells(Dlig, 3)).Copy Sheets(dk(i)).Cells(2, 1)

Je testerai le dernier fichier de Roger chez moi et vous ferai un retour sur les temps d'exécution.

@Roger : je n'ai pour l'instant regardé que la Sub tutu :

Do While v(i, 1) = c        
    If i = 1 Then Exit Do
    i = i - 1
Loop

pourquoi la condition

If i = 1 Then Exit Do

?

Quand je place un point d'arrêt sur le Exit Do la procédure ne s'arrête pas.
Y-a-t-il un cas de figure où cette condition est utile ?

A+

 

[BOISGONTIER]

Re : comment découper une liste dans différents onglets

Bonjour,

Sur le fichier joint (32.000 lignes) ESSAI2 donne 0,81 sec (0,62 sec pour Extrait)
La création du dictionnaire prend 0,22 sec.

JB

 

[david84]

Re : comment découper une liste dans différents onglets

Testé ce soir sur 1000000 de lignes/200 codes :
Tata : 14,5 s
Extrait : 14,9 s
Extrait2 : 15 s
Essai : 15,7 s
Essai2 : 16,3 s

La création du dictionnaire prend 0,22 sec.

Effectivement.

@Jacques : pour info
Afin d'éviter le test If i > n Then Exit Do j'ai remplacé

  Tblcrit = f.Cells(2, ColCritère).Resize(Derlig - 1)  
  i = 1: Premier = 1
  n = UBound(Tblcrit)
  Do While i <= n
    code = Tblcrit(i, 1)
    Do While Tblcrit(i, 1) = code
      i = i + 1: If i > n Then Exit Do
    Loop

  'suite du code

  Loop

par

  Tblcrit = f.Cells(2, ColCritère).Resize(Derlig)  
  i = 1: Premier = 1
  n = UBound(Tblcrit)
  Do While i < n
    code = Tblcrit(i, 1)
    Do While Tblcrit(i, 1) = code: i = i + 1: Loop

  'suite du code

  Loop

Mais cela n'a pas d'incidence visible sur le temps d'exécution.

A+

 

[ROGER2327]

Re : comment découper une liste dans différents onglets

Bonjour à tous.

(...)
Ceci dit si l'on veut comparer les codes ces derniers doivent remplir le même cahier des charges : le mien ventile à la mode "rustique" avec un report des entêtes "en dur", une gestion d'erreur plus que sommaire et des cas de figure non prévus tels que l'existence possible de l'onglet, etc. Et ces traitements prennent inévitablement du temps.
(...)

C'est pourquoi j'ai paramétré la procédure tutu et que je l'appelle par

Sub tata()
  tutu Me.[A1].Cells, 2, 3
'
  '[A1] : haut-gauche de la plage de données
  '2    : rang de la colonne contenant les noms d'onglets dans la plage de données
  '3    : nombre de colonnes à traiter
'
End Sub

Si la table de données commençait en C2, il suffirait d'appeler tutu Me.[C2].Cells, 2, 3.
La procédure est également prévue pour ne pas bloquer si la table de données est vide ou ne comporte qu'un enregistrement.​

(...)
@Roger : je n'ai pour l'instant regardé que la Sub tutu :

Do While v(i, 1) = c        
    If i = 1 Then Exit Do
    i = i - 1
Loop

pourquoi la condition

If i = 1 Then Exit Do

?

Quand je place un point d'arrêt sur le Exit Do la procédure ne s'arrête pas.
Y-a-t-il un cas de figure où cette condition est utile ?

Il y a effectivement une raison : si, par extraordinaire, l'un des codes était justement "CODE", l'omission de cette précaution provoquerait une erreur.
On peut aussi remplacer

        Do While v(i, 1) = c
          If i = 1 Then Exit Do
          i = i - 1
        Loop

par

        For i = i - 1 To 2 Step -1
          If v(i, 1) <> c Then Exit For
        Next

Bonne soirée.



ℝOGER2327
#8112

Vendredi 20 As 143 (Saint Olibrius, augure - fête Suprême Quarte)
1[SUP]er[/SUP] Frimaire An CCXXIV, 6,9446h - raiponse
2015-W47-7T16:40:02Z