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:
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
Valora esta pregunta
0