Copier/Coller lignes sous condition en VBA

Fermé
Samsquanch Messages postés 1 Date d'inscription mardi 20 mars 2012 Statut Membre Dernière intervention 20 mars 2012 - 20 mars 2012 à 16:04
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 - 21 mars 2012 à 16:29
Bonjour à tous,

Etant completement novice en VBA, je me retourne vers vous!

Alors voilà, j'ai une feuille d'environ 50,000 lignes expliquant la composition d'une centaine de produits. Je dois copier/coller dans une feuille différente toutes les lignes concernant un produit. Je devrait donc me retrouver avec une centaine de feuilles différentes à la fin de macro.
Les lignes sont regroupées par code,i.e. pour le premier produits, il y a une centaine de lignes commençant toutes par le code 0010754143. Il me faut alors selectionner toutes ces lignes puis les copier/coller dans une nouvelle feuille puis revenir sur la feuille principale, selectionner les centaines de lignes suivantes commençant toutes par le code 0010754135, puis les copier/coller dans une nouvelle feuille et ainsi de suite.

Comment pourrais-je m'y prendre?

Merci d'avance!
A voir également:

6 réponses

ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 2 404
20 mars 2012 à 21:09
bonsoir

un début de réponse
https://www.cjoint.com/?0CuvhZ8FvFk

sur 12000 lignes ça met environ 15 s

bonne suite
1
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 21/03/2012 à 09:47
Bonjour à tous,

pour ccm81 (ce coup ci je n'ai pas confondu avec 81 !) :o)
super ton code, je te plussoie
On pourrait peut-^tre accélérer la restitution en trouvant les lignes de début et de fin par la fonction Find; on crée ensuite une variable tableau que l'on reporte dans le classeur

modif du chrono (au passage)
Dim hdeb As Single  

hdeb = Timer

.....
'....  
' creation d'une feuille par code  
nomfp = base  
For nucode = 1 To nbcode  
  Sheets.Add  
  nomf = d(nucode - 1)  
  ActiveSheet.Name = nomf  
  Sheets(nomf).Move After:=Sheets(nomfp)  
  nomfp = nomf  
    
  'ventilation  
  With Sheets(base)  
    lidebcode = .Columns(cocodea).Find(nomf, , , xlPart).Row  
    lifincode = .Columns(cocodea).Find(nomf, , , xlPart, , xlPrevious).Row  
    transfert = .Range(.Cells(lidebcode, 1), .Cells(lifincode, 4)).Value  
    Sheets(nomf).Range("A2").Resize(UBound(transfert), 4) = transfert  
  End With  
Next nucode  
  
hfin = Now  
Sheets(base).activate  
MsgBox ("temps mis:  " & Timer - hdeb & " s")  
End Sub


a voir si on gagne des secondes sur ton test à 12000 lignes (pas sûr)

PS: le demandeur parle de code commençant par... j'ai donc remplacer xlwhole par xlpart
Michel
1
ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 2 404
21 mars 2012 à 10:54
> michel : 0.57s pour 12000 lignes, assez foudroyant!

version complète avec l'amélioration apportée par michel
https://www.cjoint.com/?0CvkZmvIz79

bonne journée à tous
1
ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 2 404
21 mars 2012 à 09:56
bonjour michel

1. j'ai vu une occasion de me lancer dans l'utilisation de l'objet "dictionary" que tu m'avais expliqué en détail il y a quelque temps
2. j'avais bien pensé faire quelque chose en copiant une "plage" de lignes, mais je n'ai pas su m'en tirer (cette fois, parce que la prochaine ....)
3. merci pour le timer, là encore mon code était un brin bourrin
4. je vais envoyer ça à mes 12000 lignes, je te dirai ce que ça donne
5. vent d'autan ce matin dans le tarn-sud

bonne journée
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 21/03/2012 à 11:23
Re,

un tuto sur les variables-tableaux
https://silkyroad.developpez.com/vba/tableaux/
très rapides car on travaille en RAM et non en feuilles XL et elles se complètent très bien avec les dictionary
bien qu'ici, les codes étant groupés, on pourrait peut-^tre aller encore + vite avec la fonction "find" paramétrée en "xlprevious"

si j'ai le temps, je te proposerai un code (je viens d'y penser en écrivant ce post)

Ici, il pleut depuis dimanche et ça fait du bien après > 3 mois sans pluie: rivières à sec, cultures et fourrages, incendies... et tans pis pour mon bronzage !!!
Michel
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
21 mars 2012 à 14:25
re,
excuse mon incruste mais le pb m'a branché! :o)
le code ci dessous parait + rapide (env. 0,08 sec avec une RAM 512Mo) sur 51 lignes.... curieux de voir sur 12000 lignes

maquette sans déclarations ni constantes à coder
Sub essai_rapidite()

'préparation globale
hdeb = Timer
Application.ScreenUpdating = False
Call RAZ

With Sheets("base")
     'initialisations
     derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
     plage = "A2:A" & derlig
     Nbre = Evaluate("sum(1/countif(" & plage & "," & plage & "))") 'nbre de code
     produit = CStr(Range("A2"))
     ligdeb = 2
     nomfp = "base"
     'parcours
     For cptr = 1 To Nbre + 1
          'creation feuille
          Sheets.Add
          ActiveSheet.Name = CStr(produit)
          Sheets(produit).Move After:=Sheets(nomfp)
          nomfp = produit
          'ventilation
          ligfin = .Columns("A").Find(produit, .Cells(ligdeb, "A"), , xlPart, , xlPrevious).Row
          transfert = .Range(.Cells(ligdeb + 1, 1), .Cells(ligfin, 4)).Value
          Sheets(produit).Range("A2").Resize(UBound(transfert), 4) = transfert
          'incrementation
          ligdeb = ligfin
          produit = CStr(.Cells(ligfin + 1, "A"))
     Next
     MsgBox ("temps mis:  " & Timer - hdeb & " s")
End With
End Sub
0
ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 2 404
21 mars 2012 à 15:05
désolé,

ça met 26 s au lieu de 0.4 s (sans "rien" qui tourne sur un 2Ghz et 3 Go) pour ta version 1 et 15 s pour la mienne
l'emploi de l'outil dictionary (me) semble plus performant

bonne suite
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 21/03/2012 à 16:32
OK, Merci!

je me demande si sams va faire signe de vie
0