¿Cómo optimizar el código de bucle VBA usando variables? -- performance campo con vba camp codereview Relacionados El problema

how to optimize vba looping code using variables?


0
vote

problema

Español

Este bucle no tiene ningún problema si tengo menos de 100 filas en la hoja de tabla de bucle. Sin embargo, si pasa más de 100 filas, el bucle toma un tiempo para filtrar y pegar valor en la hoja de bucle. ¿Hay alguna manera de optimizar este código VBA para ejecutar más rápido?

  Sub Testingloop() Dim endrown As String Dim ex As String Dim ez As String Dim eh As String Dim eg As String Dim el As String Dim ee As String Dim es As String Dim ef As String Dim ei As String Dim i As Integer Dim LastRowColumnA As Long: LastRowColumnA = Sheets("looping").Cells(Rows.Count, 1).End(xlUp).Row   Application.ScreenUpdating = False   Sheets("looping table").Select endrown = Sheets("looping table").Range("I1000").End(xlUp).Row     For i = 3 To endrown          ee= Cells(i, 9).Value         ex= Cells(i, 10).Value         ez= Cells(i, 11).Value         es = Cells(i, 12).Value         ef = Cells(i, 13).Value         ei = Cells(i, 14).Value          eh = Cells(i, 15).Value         eg= Cells(i, 16)         el= Cells(i, 17)           Sheets("looping").Select              ActiveSheet.UsedRange.AutoFilter Field:=1, Criteria1:=ee              ActiveSheet.UsedRange.AutoFilter Field:=2, Criteria1:=ex              ActiveSheet.UsedRange.AutoFilter Field:=3, Criteria1:=ez             ActiveSheet.UsedRange.AutoFilter Field:=4, Criteria1:=es             ActiveSheet.UsedRange.AutoFilter Field:=5, Criteria1:=ef               ActiveSheet.UsedRange.AutoFilter Field:=6, Criteria1:=ei             ActiveSheet.UsedRange.AutoFilter Field:=7, Criteria1:=eh         On Error Resume Next         Range("H2:H" & LastRowColumnA).SpecialCells(xlCellTypeVisible).Value = eg         Range("I2:I" & LastRowColumnA).SpecialCells(xlCellTypeVisible).Value = el             ActiveSheet.ShowAllData                 Sheets("looping table").Select                     Next i  End Sub   
Original en ingles

This looping has no problem if I have under 100 rows in the looping table sheet. However, If it go over 100 rows, looping takes a while to filtering and paste value in looping sheet. Is there any way to optimize this VBA code to run faster?

Sub Testingloop() Dim endrown As String Dim ex As String Dim ez As String Dim eh As String Dim eg As String Dim el As String Dim ee As String Dim es As String Dim ef As String Dim ei As String Dim i As Integer Dim LastRowColumnA As Long: LastRowColumnA = Sheets("looping").Cells(Rows.Count, 1).End(xlUp).Row   Application.ScreenUpdating = False   Sheets("looping table").Select endrown = Sheets("looping table").Range("I1000").End(xlUp).Row     For i = 3 To endrown          ee= Cells(i, 9).Value         ex= Cells(i, 10).Value         ez= Cells(i, 11).Value         es = Cells(i, 12).Value         ef = Cells(i, 13).Value         ei = Cells(i, 14).Value          eh = Cells(i, 15).Value         eg= Cells(i, 16)         el= Cells(i, 17)           Sheets("looping").Select              ActiveSheet.UsedRange.AutoFilter Field:=1, Criteria1:=ee              ActiveSheet.UsedRange.AutoFilter Field:=2, Criteria1:=ex              ActiveSheet.UsedRange.AutoFilter Field:=3, Criteria1:=ez             ActiveSheet.UsedRange.AutoFilter Field:=4, Criteria1:=es             ActiveSheet.UsedRange.AutoFilter Field:=5, Criteria1:=ef               ActiveSheet.UsedRange.AutoFilter Field:=6, Criteria1:=ei             ActiveSheet.UsedRange.AutoFilter Field:=7, Criteria1:=eh         On Error Resume Next         Range("H2:H" & LastRowColumnA).SpecialCells(xlCellTypeVisible).Value = eg         Range("I2:I" & LastRowColumnA).SpecialCells(xlCellTypeVisible).Value = el             ActiveSheet.ShowAllData                 Sheets("looping table").Select                     Next i  End Sub 
     
 
 

Lista de respuestas

1
 
vote
  • Primero apagado: Evite Select / / / Activate2 9988777665544333 Patrón y use completamente calificado Referencias de rango.

    Esto llevará a un mejor control sobre qué rangos en realidad está actuando y las mejores actuaciones sin todas las Hojas que saltan

    Por lo tanto, ya que está utilizando la hoja de "tabla de bucle" para filtrar los valores de los criterios con fines de lectura, mientras que el trabajo duro se realiza en la hoja de "bucle", es posible que desee actuar como sigue

      With Sheets("looping table") '<--| reference "looping table" worksheet     'your code to gather filter criteria values End With  With Sheets("looping") '<--| reference "looping" worksheet     'your code to do the filtering and writing End With   
  • Todos aquellos e S Variables llenas con el contenido de las celdas en la misma fila de fila para arrays

    Lectura de valores de la celda en una matriz y luego use este último para esas posiciones de valores es una acción de rendimiento mucho mejor

    como:

      Dim eFilters As Variant, eVals As Variant  With Sheets("looping table") '<--| reference "looping table" worksheet     eFilters = .Range("O3", .cells(.Rows.Count, "I").End(xlUp)).Value '<--| store its columns "I" to "O" values from row 3 down to column "I" last not empty one     eVals = .Range("P3:Q" & .cells(.Rows.Count, "I").End(xlUp).Row).Value '<--| store its columns "P" to "Q" values from row 3 down to column "I" last not empty one End With   
  • Una vez que tenga esas matrices, puede anidar dos bucles:

    • Loop externo para pasar por sus filas como si estuviera en bucle a través de "Tabla de bucle"

      Para este propósito, el método Application.Index()8 es muy útil, donde puede quitar una sola fila de una matriz escribiendo:

      Application.Index(myArray,iRow,0) '& lt; - | Esto hace referencia al Selection0 fila de Selection1 Array

      para que

      Selection2

      REFERENCIAS Selection3 Elementh en Selection4 fila y Selection5 columna

    • bucle interno para autofiltro Cada columna de hoja de "bucle" con correspondiente Selection6

      para que todo eso:

        Selection7  

      se convierte en algo así como

        Selection8  

      ¿Dónde Selection9 Activate0 debe ser, correspondiente, conectado al iterador de bucle interno actual y eliminado 99887776655443321 Fila actual (del bucle externo ) Array


Todo lo anterior podría resultar en el siguiente código:

  Activate2  
 
  • first off: avoid Select/Selection/Activate/ActiveXXX pattern and use fully qualified range references.

    this will lead to a better control over what ranges you're actually acting on and best performances without all that sheets jumping

    so since you're using "looping table" sheet for filtering criteria values reading purposes while the hard work is done in "looping" sheet you may want to act like follows

    With Sheets("looping table") '<--| reference "looping table" worksheet     'your code to gather filter criteria values End With  With Sheets("looping") '<--| reference "looping" worksheet     'your code to do the filtering and writing End With 
  • all those es variables filled with the content of cells on the same row call for arrays

    reading values from cell into an array and then use this latter for those values retrieval is a much better performing action

    like:

    Dim eFilters As Variant, eVals As Variant  With Sheets("looping table") '<--| reference "looping table" worksheet     eFilters = .Range("O3", .cells(.Rows.Count, "I").End(xlUp)).Value '<--| store its columns "I" to "O" values from row 3 down to column "I" last not empty one     eVals = .Range("P3:Q" & .cells(.Rows.Count, "I").End(xlUp).Row).Value '<--| store its columns "P" to "Q" values from row 3 down to column "I" last not empty one End With 
  • once you have those arrays you can nest two loops:

    • outer loop to go through their rows as if you were looping through "looping table" ones

      to this purpose the Application.Index() method comes very handy, where you can strip off a single row out of an array by typing:

      Application.Index(myArray,iRow,0) '<--| this references the iRowth row of myArray array

      so that

      Application.Index(myArray,iRow,0)(iCol)

      references myArray elementh in iRow row and iCol column

    • inner loop to AutoFilter each "looping" sheet column with corresponding Criteria

      so that all that:

       .AutoFilter Field:=1, Criteria1:=ee  .AutoFilter Field:=2, Criteria1:=ex  .AutoFilter Field:=3, Criteria1:=ez  .AutoFilter Field:=4, Criteria1:=es  .AutoFilter Field:=5, Criteria1:=ef   .AutoFilter Field:=6, Criteria1:=ei  .AutoFilter Field:=7, Criteria1:=eh 

      becomes something like

      For iFilter = LBound(eFilters, 2) To UBound(eFilters, 2) '<--| loop through 'eFilters' array columns       .AutoFilter Field:= someColumnIndex, Criteria1:=someCriteria  Next 

      where someColumnIndex and someCriteria are to be, correspondingly, connected to current inner loop iterator and stripped off eFilters current row (from outer loop) array


all what above could result in the following code:

Sub Testingloop()      Dim eFilters As Variant, eVals As Variant     With Sheets("looping table")         eFilters = .Range("O3", .cells(.Rows.Count, "I").End(xlUp)).Value         eVals = .Range("P3:Q" & .cells(.Rows.Count, "I").End(xlUp).Row).Value     End With      Dim iFilter As Long, ieVals As Long     Application.ScreenUpdating = False     With Sheets("looping").UsedRange         For ieVals = LBound(eFilters, 1) To UBound(eFilters, 1)             For iFilter = LBound(eFilters, 2) To UBound(eFilters, 2)                 .AutoFilter Field:=1 + iFilter - LBound(eFilters, 2), Criteria1:=Application.Index(eFilters, ieVals, 0)(iFilter)             Next             If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then                 With .Resize(.Rows.Count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible)                     .Offset(, 7).Value = Application.Index(eVals, ieVals, 0)(1)                     .Offset(, 8).Value = Application.Index(eVals, ieVals, 0)(2)                 End With             End If             .AutoFilter         Next     End With     Application.ScreenUpdating = True  End Sub 
 
 
1
 
vote

para un inicio:

  Activate3  

Esto no hará un impacto tremendo en el rendimiento, pero hará que su código sea más fácil trabajar. También le recomiendo encarecidamente que use la matriz en lugar de crear una cadena separada para cada valor que necesita para filtrar. Nuevamente, no un gran impacto de rendimiento, sino un buen comienzo para mejorar su codificación.

Finalmente, dependiendo de lo que su código intente hacerlo podría intentar realizar las operaciones en una matriz. También puede considerar cambiar el modo de cálculo de la hoja de trabajo a XlcalCulationManual (o algo así).

 

For a start:

Sub Testingloop() ' Move this to the top. It doesn't affect your code, but it is good practice ' to put statements like these at the top and bottom of your code to make them ' easy to find. Application.ScreenUpdating = False   ' This should be a number type and not a string Dim endrown As Long   Dim ex As String Dim ez As String Dim eh As String Dim eg As String Dim el As String Dim ee As String Dim es As String Dim ef As String Dim ei As String Dim i As Integer Dim LastRowColumnA As Long  ' Better method of loading in multiple args, this will allow you to get ' all of your args in one go, and thus will speed up performance a bit. ' Practicing this early will also make it easier to develop more complex ' projects in the future. Dim arrArgs as Variant   ' Create objects to hold the main workbook and worksheet you reference ' This allows for accurate range references. Dim wb as Workbook, Dim ws as Worksheet  ' Thisworkbook refers to the workbook containing the code. Set wb = ThisWorkbook Set ws = wb.Sheets("looping")  ' Create a variable to hold the usedrange. Dim rUsed as Range  ' Qualified your cells reference with 'ws' to ensure the proper range is set LastRowColumnA = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row  ws.Activate ' Use Activate over select, but it is best to avoid either  endrown = ws.Range("I1000").End(xlUp).Row     For i = 3 To endrown         ' When referring to the same object repeatedly, use a with block         ' This does a few things, first it allows your code to skip evaluation         ' of your 'ActiveSheet' reference since it is already told where to look.         ' It also makes your code easier to read, cleaner, and more efficient.         With ws             ee = .Cells(i, 9).Value ' Be sure to qualify your cells references             ex = .Cells(i, 10).Value             ez = .Cells(i, 11).Value             es = .Cells(i, 12).Value             ef = .Cells(i, 13).Value             ei = .Cells(i, 14).Value             eh = .Cells(i, 15).Value             eg = .Cells(i, 16).Value ' I am assuming you intended to get the value here             el = .Cells(i, 17).Value         End With          ' Instead of referring to the different ranges you could do something like         ' arrArgs = ws.Cells(i, 9).Resize(8, 1).Value           ' Using a declared variable is good practice, and may improve performance slightly         Set rUsed = ws.UsedRange         With rUsed              .AutoFilter Field:=1, Criteria1:=ee              .AutoFilter Field:=2, Criteria1:=ex              .AutoFilter Field:=3, Criteria1:=ez              .AutoFilter Field:=4, Criteria1:=es              .AutoFilter Field:=5, Criteria1:=ef               .AutoFilter Field:=6, Criteria1:=ei              .AutoFilter Field:=7, Criteria1:=eh         End With          On Error Resume Next         With ws             .Range("H2:H" & LastRowColumnA).SpecialCells(xlCellTypeVisible).Value = eg             .Range("I2:I" & LastRowColumnA).SpecialCells(xlCellTypeVisible).Value = el             .ShowAllData         End With     Next i End Sub 

This won't make a tremendous impact on performance, but it will make your code easier to work with. I also strongly encourage you to use the array instead of creating a separate string for each value you need to filter by. Again, not a big performance impact, but a good start on improving your coding.

Finally, depending on what your code is attempting to do you could try performing the operations in an array. You may also want to consider changing the calculation mode of the worksheet to xlCalculationManual (or something like that).

 
 
   
   

Relacionados problema

6  Fijación de archivos de reclamación médica a través del archivo de texto Lea / escribe  ( Fixing medical claim files through text file read write ) 
Con Gracias a @ Mat'Smug y @comintern por su aliento, aquí hay un programa que escribí para ayudar a mi equipo a reparar archivos de reclamación médica. El ...

2  Búsqueda de pruebas de abstracción y unidad en mesa Excel  ( Abstracting and unit testing lookups in excel table ) 
Fondo Tengo una solución de VBA que utilizo para ingerir informes de texto de inversión y reformatearlos para su análisis en Excel. Funciona, pero las macro...

48  Lista <T> Implementación para VB6 / VBA  ( Listt implementation for vb6 vba ) 
Recientemente, decidí que el 998877665555544330 no fue suficiente para mis necesidades, así que decidí implementar algo como C # 's List<T> . Aquí está la ...

2  Importando datos en Excel  ( Importing data into excel ) 
¿Existe una forma más fácil de importar datos en una matriz de Excel u otra estructura de datos? He intentado investigar colecciones, pero he encontrado la D...

3  Comparando células de dos hojas de trabajo  ( Comparing cells of two worksheets ) 
Con el siguiente código, trato de comparar el contenido de dos hojas de trabajo. La primera columna contiene una clave que es única y las siguientes columnas ...

5  Copiando datos de libros cerrados  ( Copying data from closed workbooks ) 
Soy un pasante en una empresa industrial en Brasil y sucede que estoy usando mucho en Excel. Acabo de empezar a jugar con VBA hace un par de días, ¡y me divie...

6  Juego de serpientes - Dentro de la hoja de trabajo - Celdas como píxeles  ( Snake game within worksheet cells as pixels ) 
Desde mi intento bastante mediocre de hacer un juego de invasores del espacio, me topé con un caché de juegos de Visual Basic para solicitar juegos escritos p...

6  Crear tabla que enumera la visibilidad de la hoja de trabajo  ( Create table that lists worksheet visibility ) 
Siguiendo mi pregunta anterior crear Una tabla que enumera las macros en un libro de trabajo o hoja de trabajo Aquí está mi Sub para determinar la visibilid...

7  Recuperando datos de archivos en la carpeta  ( Retrieving data from files in the folder ) 
Estoy a usar el código VBA para simplemente recuperar ciertos datos de todos los archivos de Excel en cierta carpeta y pegarlo en la hoja de cálculo de trabaj...

10  Imitación básica de C # enumerable en VBA - o cualquier otra clase estática  ( Basic imitation of c enumerable in vba or any other static class ) 
Desde la implementación de clases estáticas en VBA en realidad parece posible Se me ocurrió una idea para tratar de imitar C # ' 9988776655544330 clase ...




© 2022 respuesta.top Reservados todos los derechos. Centro de preguntas y respuestas reservados todos los derechos