Bucle FOR NEXT demasiado lento

[Pirtrafilla]

Hola a todos.

Os pido ayuda con este proyecto que estoy haciendo. Tal y como lo tengo ya me funciona, pero veo que tarda en recorrer demasiado las filas, creo que porque estoy usando FOR NEXT. No se si hay manera de hacerlo correr más rápido, con WHILE por ejemplo o de otra manera. Os envío el proyecto y os agradezco si me podéis ayudar porque no veo capaz.

El problema viene en la hoja Plantilla_Parte_KM, cuando uso los botones para recorrer las matrículas, la busca en una hoja con este bucle. Si la encuentra pronto no hay problema, pero si no la encuentra o está lejos en el contador del bucle se hace lento.

Como siempre gracias de antemano.

Moisés.

 

Plantilla PARTE KM (v.1).xlsm

[JSDJSD]

Hola Pirtrafilla, te dejo una opción, prueba y comenta.

Plantilla PARTE KM (v.2).xlsm

[Pirtrafilla]

Fantástico!!!

No tiene nada que ver esto con lo que yo había hecho.

Muchas gracias.

[Haplox]

En 28/11/2020 at 3:09 , Pirtrafilla dijo:

Si la encuentra pronto no hay problema, pero si no la encuentra o está lejos en el contador del bucle se hace lento.

No me extraña, tienes un bucle para 1200 filas de las que el 99% están vacías...

Con un Find te sobra. Pr cierto, si trabajas sobre la hoja activa, no hace falta para nada el "With ActiveSheet". En todo caso úsalo para trabajar sobre las otras ·With Sheets("KM_diarios)"

Copia de Plantilla PARTE KM (v.1).xlsm

[Pirtrafilla]

@Haplox, gracias por tu aporte. Tendré en cuenta lo que me dices, 

Muchas gracias por tu código.

'--> Macro por Haplo - 29/11/2020 <--
Sub BuscarMatricula()
Dim buscar$, uFila&, matricula As Range, s&

buscar = Range("B8")
uFila = Sheets("KM_diarios").Range("A" & Rows.Count).End(xlUp).Row

Set matricula = Sheets("KM_diarios").Range("A1:A" & uFila).Find(buscar)
    If Not matricula Is Nothing Then
        Range("B13:G43").ClearContents
 
        Prdia = matricula.Offset(, 3)
        km = matricula.Offset(, 4)
        conductor = matricula.Offset(, 2) & ", " & Mid(matricula.Offset(, 1), 6, 20)
        Range("G" & Prdia + 12) = km
        Range("F" & Prdia + 12) = Range("F10")
        Range("B" & Prdia + 12) = conductor
        sFila = matricula.End(xlDown).Row
        lectura = Range("F10")

        For s = matricula.Row + 1 To sFila - 1
            km = Sheets("KM_diarios").Range("E" & s)
            dia = Sheets("KM_diarios").Range("D" & s)
            Range("G" & dia + 12) = km
            Range("F" & dia + 12) = lectura + km
            lectura = Range("F" & dia + 12)
            Range("B" & dia + 12) = conductor
        Next s
    Else
        MsgBox "La matrícula " & buscar & " no tiene kilometros diarios"
    End If
End Sub