En la empresa tenemos una "Base de datos" con registros de personal, contratos, etc que se gestiona desde un formulario y funciona muy bien todo menos el botón EliminarBD que ejecuta el siguiente código.
Private Sub btn_Eliminar_Click()
Dim Ufila, ufilaD, i, j As Long
Dim ht As Worksheet
Dim hd As Worksheet
Set ht = Hoja3
Set hd = Hoja8
If Me.txt_nic = "" Then Exit Sub
If MsgBox("Seguro de eliminar TODOS los registros del item seleccionado?", vbQuestion + vbYesNo, "Borrar") = vbNo Then
Exit Sub
End If
Do While Me.txt_nic = ht.Range("A" & j)
ht.Range("A" & j).EntireRow.Delete
Loop
Next j
Me.ltb_ListaBD.Clear
Unload Me
MsgBox "Registros eliminados satisfactoriamente...", vbInformation, "Listo"
End Sub
Me gustaría aclarar que lo normal es subir el archivo para su gestión y prueba pero el departamento correspondiente no me lo puede facilitar por contener datos calientes, es como lo denominan ellos.
Este código tarda de 16 a 25 minutos en terminar su función cada vez que se presiona. La BD consta de unos 46000 registros y están desesperados ya que cada vez que lo ejecutan es un desespero.
Mi pregunta es si existe alguna función, añadido o forma de cambiar el código que haga que se ejecute más rápidamente.
Buenos días a todos,
En la empresa tenemos una "Base de datos" con registros de personal, contratos, etc que se gestiona desde un formulario y funciona muy bien todo menos el botón EliminarBD que ejecuta el siguiente código.
Private Sub btn_Eliminar_Click()
Dim Ufila, ufilaD, i, j As Long
Dim ht As Worksheet
Dim hd As Worksheet
Set ht = Hoja3
Set hd = Hoja8
If Me.txt_nic = "" Then Exit Sub
If MsgBox("Seguro de eliminar TODOS los registros del item seleccionado?", vbQuestion + vbYesNo, "Borrar") = vbNo Then
Exit Sub
End If
Ufila = ht.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Ufila
ufilaD = hd.Range("A" & Rows.Count).End(xlUp).Row + 1
If Me.txt_nic = ht.Range("A" & i) Then
hd.Cells(ufilaD, 1) = ht.Cells(i, 1)
hd.Cells(ufilaD, 2) = ht.Cells(i, 2)
hd.Cells(ufilaD, 3) = ht.Cells(i, 3)
hd.Cells(ufilaD, 4) = ht.Cells(i, 4)
hd.Cells(ufilaD, 5) = ht.Cells(i, 5)
hd.Cells(ufilaD, 6) = ht.Cells(i, 6)
hd.Cells(ufilaD, 7) = ht.Cells(i, 7)
hd.Cells(ufilaD, ? = ht.Cells(i, ?
hd.Cells(ufilaD, 9) = ht.Cells(i, 9)
hd.Cells(ufilaD, 10) = ht.Cells(i, 10)
End If
Next i
For j = 2 To Ufila
Do While Me.txt_nic = ht.Range("A" & j)
ht.Range("A" & j).EntireRow.Delete
Loop
Next j
Me.ltb_ListaBD.Clear
Unload Me
MsgBox "Registros eliminados satisfactoriamente...", vbInformation, "Listo"
End Sub
Me gustaría aclarar que lo normal es subir el archivo para su gestión y prueba pero el departamento correspondiente no me lo puede facilitar por contener datos calientes, es como lo denominan ellos.
Este código tarda de 16 a 25 minutos en terminar su función cada vez que se presiona. La BD consta de unos 46000 registros y están desesperados ya que cada vez que lo ejecutan es un desespero.
Mi pregunta es si existe alguna función, añadido o forma de cambiar el código que haga que se ejecute más rápidamente.
Gracias, un saludo.