Copier/Coller lignes sous condition en VBA
Samsquanch
Messages postés
1
Date d'inscription
Statut
Membre
Dernière intervention
-
michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention -
michel_m Messages postés 16602 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!
A voir également:
- Copier/Coller lignes sous condition en VBA
- Historique copier coller - Guide
- Copier coller pdf - Guide
- Copier-coller - Accueil - Informatique
- Style d'écriture a copier coller - Guide
- Excel cellule couleur si condition texte - Guide
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
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)
.....
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
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
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
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
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 à coder
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