¿Existe una instrucción de ejecucióon en VBA más rápida que for each?
Caballeros y Damas muy buenas tardes:
MI pregunta surge a raíz que tengo esta macro:
B = Range("C1").Text
C = Range("C2").Text
D = Range("C3").Text
E = Range("C4").Text
F = Range("C5").Text
G = Range("C6").Text
Dim lRow As Integer
lRow = Range("A" & Rows.Count).End(xlUp).Row
For Each cell In Range("A1:A" & lRow)
If Left(cell, 1) = 1 Then Workbooks.Add.SaveAs Filename:=B & cell.Value & ".xlsx"
If Left(cell, 1) = 2 Then Workbooks.Add.SaveAs Filename:=C & cell.Value & ".xlsx"
If Left(cell, 1) = 3 Then Workbooks.Add.SaveAs Filename:=D & cell.Value & ".xlsx"
If Left(cell, 1) = 4 Then Workbooks.Add.SaveAs Filename:=E & cell.Value & ".xlsx"
If Left(cell, 1) = 5 Then Workbooks.Add.SaveAs Filename:=F & cell.Value & ".xlsx"
If Left(cell, 1) = 6 Then Workbooks.Add.SaveAs Filename:=G & cell.Value & ".xlsx"
ActiveWindow.Close
Next cell
Application.ScreenUpdating = screenUpdateState
Application.DisplayStatusBar = statusBarState
Application.Calculation = calcState
Application.EnableEvents = eventsState
ActiveSheet.DisplayPageBreaks = displayPageBreaksState
End Sub
Esta macro debe recorrer los datos de la columna A, y dependiendo lo que este escrito en cada celda, crea un archivo con los nombres de cada celda, son casi 800 archivos, y aunque esta macro funciona pregunto si hay otra forma de que haga lo mismo pero mucho más rápido.
Las variables de la B, a la G, es la ruta donde debe crear los archivos
Los libros deben quedar cerrados, y guardados en las rutas señaladas, tambien si no te demanda mucho tiempo la idea es que recorra la columna A y lea cada una de las celdas, el libro que tiene esos datos tiene 6 hojas mas, porque ese es el archivo modelo por llamarlo asi, la idea es que la macro copie ese archivo a uno nuevo, y lo guarde con el nombre de cada uno de los datos que estan en la hoja1 columna A, celda por celda, si la columna A tiene 1.000 datos creara 1.000 archivos con los diferentes nombres. Crees que hay una forma o una instruccion idonea, para que esto se haga automatico, y lo mas importante rapido? Gracias por tu ayuda hermano!.
Lo siento olvide mencionar que cada archivo debe quedar con todas las mismas hojas que el archivo original.
Sin conocer, al detalle, todo tu archivo y/o lo que necesitas exactamente, mi primera impresión es que sí es con "For-Each" con que mejores resultados obtendrás (aunque los "Array" son más rápidos pero no estoy aún seguro de si puedes aplicar uno por los primeros motivos mencionados). Eso sí, para mejorar el rendimiento tienes cosas que hacer como:
- Declarar TODAS las variables que usas
- Si lo que vas a hacer, tal cual te he entendido, es tener libros iguales pero con diferentes nombres, deberías usar "ThisWorkbook.SaveCopyAs" en lugar de "Workbooks.Add". Así, además, te ahorras eso de cerrar cada libro (que definitivamente sí te consume memoria/recursos).
- Usar "Select-Case" para un caso como el que presentas, es un poco más rápido que usar "If"
Eso como para comenazar
Abraham Valencia
1 respuesta más de otro experto
Si lo que quieres hacer es copiar un archivo "modelo" y guardarlo con diferentes nombres, lo mejor sería utilizar Filecopy, para copiar el archivo en lugar de guardar el archivo desde excel.
Prueba con la siguiente macro, hice una prueba para copiar mil archivos y se demora 3 segundos.
Sub Copiar_Archivos()
'Por.Dante Amor
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'
'Almacena las rutas en un arreglo
rutas = Array(0, [C1], [C2], [C3], [C4], [C5], [C6])
ruta = ThisWorkbook.Path & "\"
arch = "modelo.xlsx" 'Pon aquí el nombre de tu archivo modelo
'
'Pone en memoria todos los valores del rango
Set r = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
For Each valor In r
n = Left(valor, 1) 'toma la ruta destino
FileCopy ruta & "modelo.xlsx", rutas(n) & valor & ".xlsx" ''copia el modelo con nombre de la celda
Next
MsgBox "Fin copiar archivos"
End SubCambia en esta línea por el nombre de tu archivo modelo:
arch = "modelo.xlsx"
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
¡Gracias! Dante que Súper buena ayuda, en realidad quiera otra ayuda más con respecto a este mismo Código pero voy a abrir otra consullta, tu asesoría ha sigo prefecta!.