Comment puis-je améliorer l'efficacité de ma boucle pour une application importante

Au lieu de copier et coller des cellules, lisez-les une fois dans la mémoire dans une matrice à 2 dimensions et écrivez le tableau dans la destination. Cela accélère considérablement le processus.

inconvénient (ou avantage, en fonction de vos besoins): seules les valeurs sont copiées. P>

call CopyRangeSheets(rng, ThisWorkbook.Sheets("TrialSheet").Range("A1"), 68)

Étant donné qu'aucune information n'était disponible sur la taille de la gamme source en cours de copie

après la suite des zones grises de la question est supposée comme suit p>

1. depuis 191 lignes x 68 copie x 3 colonnes prennent environ 10 minutes seulement (avec votre code), la plage est d'environ 191 lignes x 15 colonnes de taille p> li>

2. Comme il a été prétendu que le code fonctionne correctement. Les cellules de la plage (indépendamment de leurs positions de ligne ou de colonne) sont copiées dans la colonne A uniquement (ci-dessous l'une et l'autre). Bien qu'il contredit la déclaration "automatiser la création d'une table de données" p> li>

3. car les cellules des gammes sont copées et collées. Dans les formules de cas d'essai, les formules sont copiées uniquement. P>

   Le code ci-dessous répliquera donc simplement ce que votre code fait avec une efficacité accrue. Personnellement, je ne préfère pas conserver les calculs, le traitement des événements et la mise à jour de l'écran (dans des cas normaux), je n'ai pas ajouté que les lignes standard. Cependant, vous pouvez utiliser ces techniques standard, en fonction de la condition de fichier de travail. Effectuez les modifications nécessaires concernant la plage, etc. P> li> ol>

   code ne prend que 2-3 secondes à remplir avec 191 lignes X 15 Colonnes x 68 Copies: P>

   Sub test()
   Dim SrcWs As Worksheet, DstWs As Worksheet, SrcArr As Variant
   Dim Rng As Range, cell As Range, DstArr() As Variant
   Dim X As Long, Y As Long, Z As Long, i As Long, LastRow As Long
   Dim Chunk60K As Long
   Dim tm As Double
   tm = Timer
   Set SrcWs = ThisWorkbook.Sheets("Input Data")
   Set DstWs = ThisWorkbook.Sheets("TrialSheet")
   
   Set Rng = SrcWs.Range("A1:O191")
   SrcArr = Rng.Formula
       
   LastRow = DstWs.Cells(Rows.Count, "A").End(xlUp).Row + 1
   Chunk60K = 0
   Z = 1
       For X = 1 To UBound(SrcArr, 1)
       For Y = 1 To UBound(SrcArr, 2)
       For i = 1 To 68
           ReDim Preserve DstArr(1 To Z)
           DstArr(Z) = SrcArr(X, Y)
       
           If Z = 60000 Then  ' To Overcome 65K limit of Application.Transpose
           DstWs.Range("A" & Chunk60K * 60000 + LastRow).Resize(UBound(DstArr, 1), 1).Formula = Application.Transpose(DstArr)
           Chunk60K = Chunk60K + 1
           Z = 1
           ReDim DstArr(1 To 1)
           Debug.Print "Chunk: " & Chunk60K & " Seconds Taken: " & Timer - tm
           Else
           Z = Z + 1
           End If
       
       Next i
       Next Y
       Next X
   
   If Z > 1 Then DstWs.Range("A" & Chunk60K * 60000 + LastRow).Resize(UBound(DstArr, 1), 1).Formula = Application.Transpose(DstArr)
   
   Debug.Print "Seconds Taken: " & Timer - tm
   End Sub