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

 

[Marc L]

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

En fait il ne s'agissait pas d'efficacité (définition : atteindre le but recherché …)
mais d'efficience et là d'accord, en cas de dizaines de milliers de données,
mieux vaut travailler avec des variables tableaux et autre dictionnaire …

Mais bon vu la pièce jointe et la présentation initiale n'indiquant pas le volume à traiter,
le B-A-BA d'Excel est plus facile à appréhender pour un néophyte
qu'une solution d'un niveau avancé ou utilisant un objet externe à Excel.

Merci Roger d'être explicite la prochaine fois afin d'éviter toute méprise …

​

 

[mapomme]

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

Bonsoir à tous,

Un autre essai en VBA via TCD mais pas la méthode de Efgé! J'ai repris du code de ROGER2327 pour l'initialisation (pour 64500 enregistrements et 20 codes-> 2.9 sec. sur ma vieille bécane).

 

[Modeste geedee]

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

Bonsour®

Merci Roger d'être explicite la prochaine fois afin d'éviter toute méprise …

​

??? méprise ?

n'inversons pas les rôles !
Un soupçon de tempérance permettrai également l'usage abrupte des termes "ineptie" et "connerie" à l'endroit d'une personne qui n'a rien à prouver sur ce forum...

 

[ROGER2327]

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

Re...

Bonsoir à tous,

Un autre essai en VBA via TCD mais pas la méthode de Efgé! J'ai repris du code de ROGER2327 pour l'initialisation (pour 64500 enregistrements et 20 codes-> 2.9 sec. sur ma vieille bécane).

Bien joué !
Constaté chez moi pour 100 000 enregistrements sur 50 onglets : vous 4,2 s, moi 2,0s.
Et ça s'améliore pour un million d'enregistrements sur 500 onglets : vous 39,2 s, moi 36,7s.
Différence pratiquement insignifiante. C'est « efficient » comme dirait un certain grossier personnage.


Bonne journée.


ℝOGER2327
#8102

Dimanche 15 As 143 (Navigation du Dr Faustroll - fête Suprême Première seconde)
26 Brumaire An CCXXIV, 4,4195h - pistache
2015-W47-2T10:36:25Z

 

[BOISGONTIER]

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

Bonjour,

0,75 s pour 64.000 lignes (on conserve la présentation)

Sub Extrait()
  Set f = Sheets("BD")
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Set Rng = f.Range("A2:C" & f.[a65000].End(xlUp).Row)
  Rng.Sort key1:=f.[B2]
  a = Rng
  i = 1: n = 0
  Do While i <= UBound(a)
    code = a(i, 2)
    Do While a(i, 2) = code
      i = i + 1: If i > UBound(a) 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(2 + n, 1).Resize(i - n - 1, 3).Copy [A2]
    f.[A1:C1].Copy [a1]
    n = i - 1
  Loop
End Sub

JB

 

[gosselien]

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

ca dépends aussi du pc.... le mien est un ancêtre de 9 ans (win 7 - XL 2007)
mais c'est très rapide , c'est certain

 

[ROGER2327]

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

Re...

Bonjour,

0,75 s pour 64.000 lignes (on conserve la présentation)

Sub Extrait()
  Set f = Sheets("BD")
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Set Rng = f.Range("A2:C" & f.[a65000].End(xlUp).Row)
  Rng.Sort key1:=f.[B2]
  a = Rng
  i = 1: n = 0
  Do While i <= UBound(a)
    code = a(i, 2)
    Do While a(i, 2) = code
      i = i + 1: If i > UBound(a) 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(2 + n, 1).Resize(i - n - 1, 3).Copy [A2]
    f.[A1:C1].Copy [a1]
    n = i - 1
  Loop
End Sub

JB

Bravo.
Adapté pour de plus gros échantillons, j'obtiens 15 s pour un million d'enregistrements sur 500 onglets !

Évidemment, c'est au prix de la modification de la feuille de données.
Pour éviter cette modification, je propose :​

Sub Extrait()
  t = Timer()
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Sheets("Données").Copy Before:=Sheets(1)
  Set f = ActiveSheet
  Set Rng = f.Range("A2:C" & f.Cells(f.Rows.Count, 1).End(xlUp).Row)
  Rng.Sort key1:=f.[B2]
  a = Rng
  i = 1: n = 0
  Do While i <= UBound(a)
    code = a(i, 2)
    Do While a(i, 2) = code
      i = i + 1: If i > UBound(a) 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(2 + n, 1).Resize(i - n - 1, 3).Copy [A2]
    f.[A1:C1].Copy [a1]
    n = i - 1
  Loop
  Sheets(1).Delete
  MsgBox Timer() - t
End Sub

Ça ne coûte que 4s de plus, soit 19s dans l'exemple ci-dessus.
Deux fois plus rapide que ma proposition avec un code beaucoup plus simple !​

Bonne journée.


ℝOGER2327
#8103

Dimanche 15 As 143 (Navigation du Dr Faustroll - fête Suprême Première seconde)
26 Brumaire An CCXXIV, 5,6634h - pistache
2015-W47-2T13:35:32Z

 

[gosselien]

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

Bonjour,

le tri en début de code ferait gagner beaucoup de temps alors ? (je n'ai pas tester cette fois)

P.

 

[BOISGONTIER]

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

>le tri en début de code ferait gagner beaucoup de temps alors ? (je n'ai pas testé cette fois)

Oui, le transfert se fait par blocs et non pas ligne par ligne.

http://boisgontierjacques.free.fr/fichiers/Cellules/ExtraitBDOnglets.zip

Dans cette version, la colonne du code est paramétrée dans ColCritère

Sub Extrait()
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Sheets("BD").Copy Before:=Sheets(1)
  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)
  Rng.Sort key1:=f.Cells(2, colCritère)
  TblCrit = f.Cells(2, colCritère).Resize(Derlig - 1)
  i = 1: Premier = 1
  Do While i <= UBound(TblCrit)
    code = TblCrit(i, 1)
    Do While TblCrit(i, 1) = code
      i = i + 1: If i > UBound(TblCrit) 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
End Sub

Principe:

-Sachant que la BD est triée par code
.On mémorise dans la variable premier la position du premier item du bloc
.Dans une boucle Do While , on recherche la position du dernier item du bloc (variable i)
.On copie ce bloc dans un nouvel onglet
f.Cells(1+ Premier, 1).Resize(i - Premier - 1, Ncol).Copy [A2]




JB

PS : Ajouter un dictionnaire pour calculer le nb d'items des blocs
-Ne sert à rien (remplace une soustraction)
-Ralenti l'exécution

 

[david84]

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

Bonsoir,

une version pour voir :

Sub aEssai()
Dim t0!, t1!
  init
  DoEvents
  t0 = Timer
  Essai
  t1 = Timer
  Feuil1.Activate
  MsgBox t1 - t0 - 86400 * (t1 < t0)
End Sub

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

With Worksheets("Temp").Sort
  .SortFields.Clear
  .SortFields.Add Key:=R.Columns(2) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
  .SetRange R.Columns(2)
  .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

Plig = 1: Dlig = di(0)

For i = 0 To UBound(dk)
  On Error Resume Next
  Sheets.Add After:=Sheets(Sheets.Count)
  ActiveSheet.Name = dk(i)
   
  With Sheets(dk(i))
    .Cells(1, 1) = "NOM": .Cells(1, 2) = "CODE": .Cells(1, 3) = "ADRESSE"
    Sheets("temp").Range(Sheets("temp").Cells(Plig, 1), Sheets("temp").Cells(Dlig, 3)).Copy Sheets(dk(i)).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+

 

[bolem]

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

Je vais finalement peut-être partir sur cette version....
c'est pour moi la plus simple à utiliser avec des explications dans le code tata qui me vont bien.
je vais peut etre abuser mais j'aime bien comprendre....
est-il possible d'avoir des explications sur le code mais bon je devrais peut etre trouvé un cours pour expliquer les différentes fonctions/lignes (conseil pour que je puisse retrouver ce que veux dire ubound, scripting.dictionnary.... )
et pourquoi faire une subroutine toto, tout cela n'aurait pas marché dans tata ?

merci encore

 

[laetitia90]

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

bonjour tous

JB je viens de regarder ton dernier post code tres interessant

je me pose une qst.... pas le temps helas de faire des essais

du moment qu'on part sur un tablo trié pour eviter Do While pour recherche dernier element pour definir la copy

peut être utiliser FIND ou dico en partant du bas pour trouver dernier element

=>on connait les dimensions du tablo a transferer & du coup la ligne du suivant premier du deuxieme tablo ect...
mais désole pas le temps de batir cela & tester

 

[BOISGONTIER]

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

Bonsoir Laeticia90,

-Je crois que ce sont les 2 boucles Do While emboîtées qui 'dérangent'
-Ici, l'Array est balayé une seule fois avec l'indice i (malgré les 2 boucles).
-Je suppose que David84 a utilisé un dico pour éviter ces 2 boucles. Il faut explorer un Array pour constituer le dico.
-Je ne penses pas que l'utilisation de Find améliorerait le temps d'exécution(Ceci serait du temps en plus)
-Ce qui fait le gain du temps d'exécution, c'est le transfert par Blocs (possible grâce au tri) .
-La gestion des boucles Do While ne prend que 3% du temps global. Ce n'est donc pas sur cette partie qu'il faut espérer un gain.

  t = Timer()
  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
    Premier = i
  Loop
  MsgBox Timer() - t

JB

 

[david84]

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

Bonsoir,

testé chez moi :
Sub Ventiler (TCD): 0,7 sec sur 32000 lignes/6 codes, 19 sec sur 500000 lignes/200 codes
Sub Tata : 0,5 sec sur 32000 lignes/6 codes, 14 sec sur 500000 lignes/200 codes
Sub Extrait : 0,3 sec sur 32000 lignes/6 codes, 10 sec sur 500000 lignes/200 codes
Sub Essai : 0,2 sec sur 32000 lignes/6 codes, 7 sec sur 500000 lignes/200 codes

Cela laisse supposer que le tri préalable soit effectivement la solution la plus rapide.
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.

A+

PS : test effectué sur l'excellent fichier de Roger

 

[gosselien]

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

tests effectués avec quel type de PC ?
c'est du rapide ça