Macro affreusement longue! Résolu

Question

Bonjour tout le monde,

J'ai une macro très simple et pourtant très longue.
Voici le code


Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = True

Application.ScreenUpdating = False

    Columns("A:B").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    
MsgBox ("on est sur la dernière feuille normalement")
    
Range(Cells(1, 1), Cells(3, 2)).Delete shift:=xlUp

alle = Application.WorksheetFunction.CountA(Range("A:A"))
      
    For eee = 1 To alle * 2 Step 2
    Cells(eee, 2) = Cells(eee, 2) / 1000
        Cells(eee + 1, 1).Insert shift:=xlDown
        Cells(eee + 1, 2).Insert shift:=xlDown
        Cells(eee + 1, 1) = Cells(eee, 1)
        Cells(eee + 1, 2) = Cells(eee, 2)
    Next eee
    
Application.Calculation = xlCalculationAutomatic
    
MsgBox ("les consos ont été doublées et il n'y a plus qu'a copier les colonnes")

    Columns("B:B").Select
    Selection.Copy
    Columns("C:C").Select
    ActiveSheet.Paste
    Range("D1").Select
    ActiveSheet.Paste
    Range("E1").Select
    ActiveSheet.Paste
    Range("F1").Select
    ActiveSheet.Paste
    Range("G1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
MsgBox ("allez lààààà")



Déjà avant je lui faisais insérer des lignes entières et il pouvait carrément pas faire la macro (mémoire insuffisante qu'il disait). Maintenant ça marche mais c'est impressionnant de la longueur de ce truc. ( bon j'avoue j'ai 130 000 lignes, mais quand même...)

J'ai pourtant fouillé sur les furoms et rajouté les ptites astuces qui vont bien mais rien n'y fait.
Je veux qu'il me double toutes les lignes.
Voilà, si quelqu'un trouve ça m'aiderait beaucoup.

f894009 · Answer

Bonjour,

exemple de code, nom de feuille et cellule a adapter.

Option Base 1
Sub test()
    Dim tablo1, tablo2
    Dim indice As Long

    'derniere ligne colonne A
    alle = Application.WorksheetFunction.CountA(Worksheets("feuil1").Range("A:A"))
    
    ReDim tablo1(alle, 2)
    ReDim tablo2(alle * 2, 2)
    'mise en memoire des donnees a calculees
    tablo1 = Worksheets("feuil1").Range("A1:B" & alle)
    
    a = Timer
    'init comptage tablo2
    indice = 1
    'boucle de comptage
    For x = 1 To alle
        'boucle doublage
        For y = 1 To 2
            tablo2(indice, 1) = tablo1(x, 1)
            tablo2(indice, 2) = tablo1(x, 2) / 1000
            indice = indice + 1
        Next y
    Next x
    'ecriture des donnees calculees
    Worksheets("feuil1").Range("D1").Resize(UBound(tablo2, 1), UBound(tablo2, 2)) = tablo2

    MsgBox "temps: " & Timer - a
End Sub



Bonne suite

roupille008 · Answer

Primo, merci de répondre au sujet.
Deuxio, j'ai essayé et ton code ne  fonctionne pas chez moi.
Il me ressort au bout d'une seconde environ 1 seule colonne et pas les deux.
Tertio, par contre la colonne qu'il me sort a bien été doublé si l'on en croit le nombre de lignes.

Et vu que ton code est de plus haut vol que le mien, j'arrive pas à situer l'erreur.
J'vais me pencher dessus car vu qu'il n'a mis que 1 seconde pour me doubler une colonne, si il met 2 sec pour faire mes deux colonnes je serais le roi du monde!

Merci encore!

f894009 · Answer

Bonjour, 

Il me ressort au bout d'une seconde environ 1 seule colonne et pas les deux.  le code que je vous ai donne donne deux colonnes D et E dans le fichier que j'ai utilise. Pour vous il faut l'adapter. 

Et vu que ton code est de plus haut vol que le mien Non, c'est une vision differente de la programmation 

Une seconde et quelque c'est normal meme si deux colonnes. 

Si votre fichier n'a pas de donnees confidentielles, vous pouvez le mettre a dispo en cliquant sur ce lien: https://www.cjoint.com/ 

Si vous ne voulez pas que ce fichier soit public passez par les messages prive. 

A+

Macro affreusement longue!

3 réponses

Votre réponse

Discussions similaires

Newsletters