Excel - Macro de novato va muy lenta :(

 
Vista:
sin imagen de perfil

Macro de novato va muy lenta :(

Publicado por anonymous (3 intervenciones) el 27/10/2019 22:08:44
Buenas noches,

Estoy intentado hacer un formulario de consulta de una pequeña base de datos (control vehículos de un pàrquing). He hecho un par de macros para que me copien datos de los vehiculos que entran o sale en una seguna hoja que genera un registro (día, hora, vehículo, titular, ...).

La cuestió es que tardan unos segundos en ejecutarse, deduzco que por la rudez de mi código, que seguro se podría simplificar en unas pocas línias de código para alguien con más conocimientos.

Os lo copio a continuación por si alguien me puede echar una mano,

Mil gracias de antemano!

Ahi va:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub ENTRADES()
 
    Application.ScreenUpdating = False
    Sheets("HISTORIAL VEHICLES").Select
    Dim UltimFila As Long
    UltimaFila = Range("A65536").End(xlUp).Row
    UltimaFila = UltimaFila + 1
    Cells(UltimaFila, 1).Select
    ActiveCell.FormulaR1C1 = Date
    UltimaFila = UltimaFila
    Cells(UltimaFila, 2).Select
    ActiveCell.FormulaR1C1 = Format(Now, "hh:mm")
    Application.ScreenUpdating = False
    Sheets("BASE DADES (2)").Select
    Range("G23").Select
    Selection.Copy
    Sheets("HISTORIAL VEHICLES").Select
    Cells(UltimaFila, 3).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("BASE DADES (2)").Select
    Range("K21").Select
    Selection.Copy
    Sheets("HISTORIAL VEHICLES").Select
    Cells(UltimaFila, 4).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.ScreenUpdating = False
    Sheets("BASE DADES (2)").Select
    Range("L21").Select
    Selection.Copy
    Sheets("HISTORIAL VEHICLES").Select
    Cells(UltimaFila, 5).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    UltimaFila = UltimaFila
    Cells(UltimaFila, 6).Select
    ActiveCell.FormulaR1C1 = "X"
    Dim lastrow As Integer
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Cells(lastrow, 1).Offset(1, 0).Select
    Sheets("BASE DADES (2)").Select
    Range("C7:C10").Select
    Selection.ClearContents
End Sub
Captura-de-pantalla-2019-10-27-a-las-22.17.20
Captura-de-pantalla-2019-10-27-a-las-22.12.08
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Macro de novato va muy lenta :(

Publicado por Antoni Masana (2481 intervenciones) el 28/10/2019 16:02:17
No se que hace exactamente la macro, Si veo que copia de una hoja a otra.

Este par de detalles no son los responsables de que tarde pero es interesante tener en cuenta:

1
Application.ScreenUpdating = False

Esta tres veces en el código y con poner uno a False al inicio del código y otro a True al final es suficiente.

1
UltimaFila = UltimaFila

Esta es una de las cosas más inútiles en programación porque no hacen algo útil y sirven para perder tiempo y hacer el código confuso.

Otro detalle es ¿Que versión de Excel tienes?

Creo que hasta la versión 2003 eran 65535 filas y en la siguiente versión, 2007 ya eran 1048576 filas.
Por lo que la forma de buscar la última fila no es exactamente la mejor.

En esta pagina te cuenta como hacerlo:

https://www.excel-avanzado.com/18358/seleccionar-la-primera-fila-o-columna-en-blanco.html

1
2
3
4
5
Sub macro4()
    Dim lastrow As Integer
    lastrow = Cells(Rows.Count, 1).End(xlUp).Row
    Cells(lastrow, 1).Offset(1, 0).Select
End Sub

Tiene una pega: si tienes 10 líneas de datos te dice que la primera libre es la 11. Si borras una línea de datos te sigue diciendo que la primera libre es la 11 y no la 10 como caldria suponer.

Y todo esto no responde a tu pregunta porque la macro sigue siendo lenta.

Tendría que ver que hace, como lo hace y donde pierde el tiempo y probar otras opciones para ver como hacerla más rápida.

Por lo que ayudaría mucho si puedes subir el libro, si no el original, por lo de datos confidenciales, al menos uno de muestra donde la macro funcione igual de lenta.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

Macro de novato va muy lenta :(

Publicado por anonymous (3 intervenciones) el 29/10/2019 20:32:11
Muchas gracias por tu aportación Antoni, como ya comenté, aun voy super perdido en este mundillo.. La macro básicamente lo que hace es copiar datos de una hoja a otra. Dado que es una plantilla y aun no está cargado ningún dato, cuelgo una copia del libro entero a ver cómo lo ves..
Y ya puestos a preguntar.. a ver si me supieras decir cómo puedo vincular una foto a una celda.. porqué por muchos tutoriales que he leído y visto no me acaba de salir.
Mil gracias de antemano. David
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Macro de novato va muy lenta :(

Publicado por Antoni Masana (2481 intervenciones) el 30/10/2019 15:41:32
Prueba esta macro haber si funciona más rápida:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub ENTRADES()
    Dim Vehicle As String, Identif As Long, Nom_Cog As String, Ult_Fila As Long
 
    Application.ScreenUpdating = False
 
    ' ---&--- Le los datos a copiar
 
    Vehicle = Range("G23")
    Identif = Range("G23")
    Nom_Cog = Range("G23")
 
    ' ---&--- Comprueba que esten todos los datos
 
    If Vehicle = Empty Or Identif = Empty Or Nom_Cog = Empty Then
       MsgBox "Falta per ompli les dades", vbCritical, "DADES"
       Exit Sub
    End If
 
    ' ---&--- Busca la primera fila libre
 
    Sheets("HISTORIAL VEHICLES").Select
 
    Ult_Fila = 1
    While Cells(Ult_Fila, 1) <> ""
        Ult_Fila = Ult_Fila + 1
    Wend
 
    ' ---&--- Crea la nueva entrada
 
    Cells(Ult_Fila, 1) = Date
    Cells(Ult_Fila, 2) = Format(Now, "hh:mm")
    Cells(Ult_Fila, 3) = Vehicle
    Cells(Ult_Fila, 4) = Identif
    Cells(Ult_Fila, 5) = Nom_Cog
    Cells(Ult_Fila, 6) = "X"
 
    ' ---&--- Limpia antes de salir
 
    Sheets("BASE DADES (2)").Select
    Range("C7:C10").Select
    Selection.ClearContents
End Sub

Saludos.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

Macro de novato va muy lenta :(

Publicado por anonymous (3 intervenciones) el 30/10/2019 18:44:44
Eres un genio Antoni! Como decía Francis Bacon el conocimiento es poder! Funciona genial y sin lentitudes. Lo único es que, como en realidad si NO hay información en las celdas aparece el mensaje de error que está camuflado (por el tema de las fórmulas del condicional y buscar v), no aparece el mensaje de texto si no hay datos. No se si me explico. Dicho de otro modo, si genero una entrada o salida sin introducir datos me salta el depurador de errores en lugar del msgbox.
A la vista de tus conocimientos, no sé si podrías orientarme acerca del tema de vincular fotos en celdas..por aquí o via mail. Prometo buscar la forma de compensarte :) Mil gracias otra vez!
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar