¿Cómo acelerar macro para enviar datos a base de datos?
Tengo un pequeño programa donde ingreso datos y que estos estos datos se van llenando en 3 listbox (los datos se llenan fila por fila al mismo tiempo en los 3 listbox) y cuando se llenan los 3 listbox (14 filas máximo) ejecuto la macro para que los datos lo envíe a una base de datos (libro excel), pero esta macro se ejecuta lentamente y demora para enviar datos a la base de datos.
Lo que deseo es una macro, modificaciones o sugerencias de como puedo acelerar la macro para que esta macro envíe más rápido los datos a la base de datos. La macro:
Private Sub AgregarBD_Click()
fila = 2
Workbooks("BD_Ventas.xlsm").Worksheets("Ventas").Activate
Worksheets("Ventas").Unprotect "191174"
Do While Worksheets("Ventas").Cells(fila, 1) <> Empty
fila = fila + 1
Loop
fFinal = fila 'el resultado se almacena en la variable fFinal
'Agregamos todos los items del listbox a la hoja de calculo
For a = 0 To ListBox1.ListCount - 1 'recorremos todos los items desde el principio hasta el final
With Worksheets("Ventas")
.Cells(fFinal, 1).Value = Val(Label11)
.Cells(fFinal, 2).Value = DOC_REF
.Cells(fFinal, 3).Value = Val(TextBox7)
.Cells(fFinal, 4).Value = CDate(TextBox4)
.Cells(fFinal, 5).Value = Val(TextBox11)
.Cells(fFinal, 6).Value = ComboBox12
.Cells(fFinal, 7).Value = Val(Label102)
.Cells(fFinal, 31).Value = Val(Label81)
.Cells(fFinal, 32).Value = Val(Label82)
.Cells(fFinal, 8).Value = Val(ListBox1.List(a, 0))
.Cells(fFinal, 9).Value = Val(ListBox1.List(a, 1))
.Cells(fFinal, 10).Value = ListBox1.List(a, 2)
.Cells(fFinal, 11).Value = Val(ListBox1.List(a, 3))
.Cells(fFinal, 12).Value = ListBox1.List(a, 4)
'Continua 5 filas mas listbox1...
.Cells(fFinal, 18).Value = Val(ListBox2.List(a, 0))
.Cells(fFinal, 19).Value = Val(ListBox2.List(a, 1))
.Cells(fFinal, 20).Value = Val(ListBox2.List(a, 2))
.Cells(fFinal, 21).Value = Val(ListBox2.List(a, 3))
.Cells(fFinal, 22).Value = Val(ListBox2.List(a, 4))
'Continua 5 filas mas listbox2...
.Cells(fFinal, 28).Value = Val(ListBox3.List(a, 0))
.Cells(fFinal, 29).Value = Val(ListBox3.List(a, 1))
.Cells(fFinal, 30).Value = Val(ListBox3.List(a, 2))
End With
fFinal = fFinal + 1 'sumamos 1 para ir bajando de fila
Next
a = 0 'reinicializamos la variable
Worksheets("Ventas"). Protect "191174"
ActiveWorkbook. Save
End Sub
Esta macro no lo elabore yo, lo encontre en la internet y lo adapte a mis necesidades.
3 Respuestas
Las 2 sugerencias que te enviaron acelerarán el proceso:
Application.ScreenUpdating = False, para no ver los cambios en la hoja ante cada pase.
Y el modo de obtener la primer fila libre, buscandola desde abajo hacia arriba en lugar de recorrer todo el rango.
A estas sugerencias le agrego otra que también es fundamental. Si tu libro contiene fórmulas, tablas dinámicas o gráficos que se actualizan al cambio de resultados... hay que evitar el recálculo mientras se esté enviando datos a la hoja:
Antes del bucle For a = 0 To ... colocá esta para pasar el cálculo a modo manual:
Application.Calculation = xlCalculationManual
Y luego del Next, cuando se terminó el bucle del pase de datos, pasar nuevamente a cálculo automático:
Application.Calculation = xlCalculationAutomatic
Espero que con estas opciones ya puedas dar por resuelto tu problema.
Si aún persiste será cuestión de revisar el peso del libro y si es mucho, las razones del mismo.
¡Gracias! Primeramente agradecer enormemente a los Expertos Cecilio y Dante, y en especial a la Experta Elsa Matilde por dar el toque final a mi problema, en VERDAD se reducio a la mitad del tiempo el envío de los datos y eso es bueno para mi. Para acotar, mi libro pesa 16.5 MB (datos rellenados / columnas = A-AM filas = 85000). Acepto cualquier sugerencia o opinión sobre que hacer con libros que contiene muchos datos. Bendiciones a la sociedad de Todoexpertos, asta la próxima.
Te anexo la macro con algunas actualizaciones
Private Sub AgregarBD_Click()
'
'Act.Por.Dante Amor
'
'
Application.ScreenUpdating = False
'
Set l1 = ThisWorkbook
Set l2 = Workbooks("BD_Ventas.xlsm")
Set h22 = l2.Sheets("Ventas")
fila = 2
h22.Unprotect "191174"
fFinal = h22.Range("A" & Rows.Count).End(xlUp).Row + 1
'Agregamos todos los items del listbox a la hoja de calculo
Dim a
For a = 0 To ListBox1.ListCount - 1 'recorremos todos los items desde el principio hasta el final
With h22
.Cells(fFinal, 1).Value = Val(Label11)
.Cells(fFinal, 2).Value = DOC_REF
.Cells(fFinal, 3).Value = Val(TextBox7)
.Cells(fFinal, 4).Value = CDate(TextBox4)
.Cells(fFinal, 5).Value = Val(TextBox11)
.Cells(fFinal, 6).Value = ComboBox12
.Cells(fFinal, 7).Value = Val(Label102)
.Cells(fFinal, 31).Value = Val(Label81)
.Cells(fFinal, 32).Value = Val(Label82)
.Cells(fFinal, 8).Value = Val(ListBox1.List(a, 0))
.Cells(fFinal, 9).Value = Val(ListBox1.List(a, 1))
.Cells(fFinal, 10).Value = ListBox1.List(a, 2)
.Cells(fFinal, 11).Value = Val(ListBox1.List(a, 3))
.Cells(fFinal, 12).Value = ListBox1.List(a, 4)
'Continua 5 filas mas listbox1...
. Cells(fFinal, 18).Value = Val(ListBox2.List(a, 0))
. Cells(fFinal, 19).Value = Val(ListBox2.List(a, 1))
. Cells(fFinal, 20).Value = Val(ListBox2.List(a, 2))
. Cells(fFinal, 21).Value = Val(ListBox2.List(a, 3))
. Cells(fFinal, 22).Value = Val(ListBox2.List(a, 4))
'Continua 5 filas mas listbox2...
. Cells(fFinal, 28).Value = Val(ListBox3.List(a, 0))
. Cells(fFinal, 29).Value = Val(ListBox3.List(a, 1))
. Cells(fFinal, 30).Value = Val(ListBox3.List(a, 2))
End With
fFinal = fFinal + 1 'sumamos 1 para ir bajando de fila
Next
'a = 0 'reinicializamos la variable
Application.ScreenUpdating = True
h22.Protect "191174"
l2.Save
End SubTambién te recomiendo lo siguiente. Al final de tu macro tienes l2.Save, para guardar el libro con los cambios. Si vas a realizar varios cambios, te recomiendo que guardes el archivo hasta el final de tus operaciones, ya que si el libro es bastante grande y lo guardas por cada cambio, entonces el proceso de guardar se realizará cada vez, haciendo lento el proceso.
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
