Código muy lento para eliminar repetidos

[YianTheJOP]

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.

[Janlui]

Al principio de tu macro pon:

Application.ScreenUpdating=False

 

[YianTheJOP]

Ok @Janlui mañana lo pongo y te cuento. Gracias. 

[Gerson Pineda]

Hace 2 horas, YianTheJOP dijo:

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. 

Sube una muestra con datos ficticios 

46mil registros a procesar no debe representar 25 minutos para eliminar filas, es mucho tiempo

Si hay métodos para que el proceso sea mas rápido , además de incluir otras líneas que sirven para agilizar los procesos, especialmente si ese libro contiene mucho recalculo 

Lo que se entiende de ese código, es que antes de eliminar los elementos que coinciden, los almacenas en otra hoja y luego vuelves a recorrer los mismos para eliminarlos 

 

Saludos

[YianTheJOP]

Gracias @Gerson Pinedapor molestarte. Respecto a lo de subir el archivo sé por otras ocasiones que he preguntado qué es lo correcto y hoy les he pedido una copia sin los datos y me la han negado con buenas palabras y los entiendo ya que está "toda la vida" del personal ahí dentro. Mañana les haré entender que para estudiar el código necesito una copia a ver si hay suerte. 

Y tienes razón en que lo que realiza es buscar en la BD información, la encuentra, Alcorta y la pega en otra hoja y después sigue buscando y sigue realizando lo mismo. Me deja un poco parado lo que me comentas de que vuelve a empezar a buscar y localizar, yo pensaba en que continuaba donde lo había dejado. 

respecto a lo de 25 minutos es cierto, hoy me han dicho que podía tardar 16 minutos y han hecho una prueba delante mío y el resultado han sido 25 minutos de reloj!!!! Una locura. 

 

[Gerson Pineda]

Sube una muestra hecha por ti, con datos ficticios, simulando la estructura real, no necesitamos tu proyecto 

También comentarte que tienes bucles demás... 

 

Saludos

[YianTheJOP]

Ok, lo que comentas es lo más lógico. Haré eso, intentaré "copiar" la estructura y subir una muestra, a ver si me podéis ayudar. Intentaré subirla entre mañana y el sábado, ok? Y mil gracias. 

[YianTheJOP]

Buenos días a todos,

@Gerson Pineda @Janlui adjunto el archivo Excel sin datos de personal y eliminado los logos, etc de toda referencia a la empresa, o eso creo, espero no meterme en un jaleo.

He tenido que sobornar a un compañero para conseguirlo

Añado estas capturas también.

A ver si me podéis ayudar.

Gracias.

 

Gestión FECHAS empleados COPIA.xlsm

[Janlui]

Comentas que un código de empleado se encuantra repetido varias veces en la BD? y esos registros los deberá eliminar pero todos los eliminados los quieres pojner en una hoja en particular?

 

[YianTheJOP]

Si y no. A ver si te lo explico bien. 

Cada trabajador tiene un único código en la empresa pero..... Tiene en la BD unas 60 o 70 entradas diferentes. Para que la BD pueda trabajar bien y con un registro único, al final de la fila réplica su código de empleado + 1, código empleado +2, código empleado+3 y así repetidamente. El número añadido detrás de su número de empleado es su primer contrato o entrada, segundo contrato o entrada, tercera entrada,etc. 

Con este fichero gestionan los contratos de personal eventual y cada semana les hacen un contrato nuevo, políticas de empresa. 

[Janlui]

Pero no me queda claro:

Esiste un empleado con godigo 10513 y han renovado su contrato 50 veces  = existen 50 filas ej. 50513 - 1 hasta 50513-50

Cuando dices eliminar... cual eliminas Todos o alguno en particular

 

[Janlui]

Has una tabla de con numero inventados pero con codigos reales y ahi explicalo.

[YianTheJOP]

Ok. Mañana intento meter datos ficticios. 

[Gerson Pineda]

Hace 2 horas, YianTheJOP dijo:

Ok. Mañana intento meter datos ficticios. 

He visto tu archivo y según tu duda con el código inicial, es eliminar según lo escogido en el Textbox

Aclara si deseas eliminarlos /moverlos todos o que quede solo uno en la BD

 

 

Saludos 

[YianTheJOP]

Hola @Gerson Pineda lo que se busca es lo que hace pero más rápido. 

Te resumo,,,, eliminar los datos que salen en el textbox de la hoja BD "todos" ya que se supone que ese trabajador no trabajara más con nosotros. Pero...... Que realice una copia de todo lo eliminado de la BD en la hoja KO o algo así se llama, que ahora no puedo mirarlo, por si alguna vez decide venir a trabajar otra vez o simplemente para consultar posteriormente. 

La función que realiza el botón es totalmente correcta actualmente pero es eternamente lenta. 25 minutos para eliminar a una persona de la BD y realizar copia en hoja KO. Una locura!!!!?

[Janlui]

Te dejo un archivo como de 50,500  registros de Empleados, Tarda menos de 5 seg. para eliminar todos los registros correspondientes al mismo empleado.

Solo adáptalo a tu BD.

Coloca en la Celda M3 el numero de empleado y da clic en el Botón de eliminar

 

Baja de Empleados.xlsm

[YianTheJOP]

Lo miro mañana que no tengo acceso ahora al ordenador. @Janlui gracias por molestarte. Un saludo. 

Otra cosa..... Si creéis que este archivo es digno después de mejoras publicarse aquí podéis cualquiera colgarlo en otro sitio del foro para que sea útil a cualquiera. Es un poco "complejo" pero es útil para un departamento de RH. Habréis visto que tiene calculadora entre fechas, avisos directos en Outlook, alertas,etc para gestionar contratos. Yo no tengo tiempo de publicarlo, solo pido que se mire bien y se borre todo rastro de referencias a mí empresa y ya está. Ojalá le sea útil a alguien. 

Gracias. 

[JSDJSD]

Hola, aprovechando el  archivo de  Janlui     mira si cunde copiar el empleado seleccionado  en hoja respaldo y borrarlo de la base de datos con más de 50000 líneas.

[JSDJSD]

Uff¡¡ Te dejo el archivo para que lo pruebes y comentes.

Baja de Empleados(1).xlsm

[JSDJSD]

Por cierto no llega a 1 segundo todo el proceso.

[Gerson Pineda]

Tu archivo  esta cargadito y es lo que precisamente imagine, pues esto tiene impacto directo con el rendimiento de cada proceso  que corres

Es decir no es lo mismo realizar un procedimiento en un libro relativamente limpio que sobre el tuyo, esa es la razón principal por la lentitud de este y todos los procesos que llevas a cabo

Si es mejorable y se debe revisar cada hoja, pe: a la hoja BD TRABAJADORES y BD_DELETE yo les elimino las macros de evento que tienes en cada una [estas macros, impactan directamente pues cada que seleccionas una celda se activa y eso es un crimen jaja al ejecutar la eliminación y copia de registros] y podrías agregar una que haga lo mismo pero al seleccionar/activar la hoja

Private Sub Worksheet_Activate()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

    Range("A:J").EntireColumn.AutoFit

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Aunque ya he visto que has recibidos aportes de Jsd y Janlui, pero de todas maneras te dejo mi versión, para que puedas probar y de paso nos comentas

Ojo desde ya te adelanto que su tiempo de proceso es aceptable, pero al adaptarla en tu archivo, no será igual, y también estará relacionado a cuantos registros existen para eliminar, es decir no es lo mismo eliminar 15 registros de 50mil, que 500 de 50mil o 100mil o 500mil

 

Saludos!

Eliminar registros_GP.xlsm

[YianTheJOP]

Estoy mirando e intentando entender y...... es una pasada!!!!!  Está perfecto tanto el aporte de @Janlui como el añadido de @JSDJSD como la versión de @Gerson Pineda.

Ahora solo me falta implementarlo en el archivo Excel y darle un par de vueltas, mi intención es realizar 2 archivos con las 2 ideas y ver cual funciona más rápido funcionando en un escenario real. 

Intentaré el lunes, martes tenerlo listo "con todos los datos reales de los empleados" y ver como reacciona y cual deciden quedarse.

Por supuesto que os comentaré por aquí la velocidad exacta de las ideas planteadas   

Muchísimas gracias chicos por su tiempo. 

El lunes, martes comento. Un saludo.

[YianTheJOP]

Buenas tardes chicos,

impresionante!!! Ha pasado de tardar unos 25 minutos a solo 50segundos ?

Hemos usado los datos reales del personal y están alucinando. 

Al final he usado la propuesta de @Janlui @JSDJSD

La propuesta de @Gerson Pineda yo la entendía mucho más y es la primera que integré pero inexplicablemente me marcaba fallo en el tema de mostrar los segundos en ejecutar la macro. No sé si será por la versión de Excel, trabajamos con Excel365.

Como siempre muchísimas gracias por vuestra ayuda desinteresada siempre. 

un saludo. 

[Gerson Pineda]

Hace 38 minutos , YianTheJOP dijo:

La propuesta de @Gerson Pineda yo la entendía mucho más y es la primera que integré pero inexplicablemente me marcaba fallo en el tema de mostrar los segundos en ejecutar la macro. No sé si será por la versión de Excel, trabajamos con Excel365.

También utilizo 365, pero es posible que sea por adaptación, la he probado nuevamente y no hay fallos

Observa

Lo que debes cambiar es la variable y la columna a evaluar, para eliminar

 

Saludos

[JSDJSD]

En excel 2019 funciona perfectamente sin hacer ningún cambio la aportación del Maestro Gerson Pineda