Copier/Coller lignes sous condition en VBA Fermé

Question

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!

ccm81 · Answer

bonsoir

un début de réponse
https://www.cjoint.com/?0CuvhZ8FvFk 

sur 12000 lignes ça met environ 15 s

bonne suite

michel_m · Answer

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

ccm81 · Answer

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

ccm81 · Answer

> 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

michel_m · Answer

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

ccm81 · Answer

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

Copier/Coller lignes sous condition en VBA

6 réponses

Discussions similaires