Copier/Coller lignes sous condition en VBA
Samsquanch
Messages postés
1
Statut
Membre
-
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
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!
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!
6 réponses
-
bonsoir
un début de réponse
https://www.cjoint.com/?0CuvhZ8FvFk
sur 12000 lignes ça met environ 15 s
bonne suite -
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 -
> 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 -
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 -
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question -
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-
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 à coderSub 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
-
-
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
