Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Visual Basic para Aplicaciones » Macro VBA muy lenta

Visual Basic para Aplicaciones - Macro VBA muy lenta

Life is soft - evento anual de software empresarial
Volver
Nuevo Tema
<<>>
 
Vista:

Macro VBA muy lenta

Publicado por Juan Antonio (1 intervención) el 21/05/2018 15:55:12
Buenas tardes,

tengo esta macro en VBA para excel

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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Sub Cambio_diseño_()
'

' Cambio_diseño_ Macro

' Esta macro da formato para pegar el cambio de diseño en el correo

'

' Acceso directo: CTRL+l

'

 
' Empezamos copiando lo que viene de AL2

    Range("AL2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ' ActiveWindow.LargeScroll ToRight:=-1

    Range("C2").Select
    ActiveSheet.Paste
 
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:M").Select
    Selection.Delete Shift:=xlToLeft
    Columns("K:AD").Select
    Selection.Delete Shift:=xlToLeft
 
    Range("A1:J1").Select
    Selection.Font.Bold = True
 
    ' Range("A1:J3").Select   ' TENEMOS QUE SELECINAR HASTA EL ÚLTIMO, NO SOLAMENTE 3

 
'    Set a = Range("A1", Range("A1").End(xlDown))

'    Set b = Range("E1", Range("E1").End(xlDown))

'    Union(a, b).Select

 
    a = Range("A1:J1", Range("A1").End(xlDown)).Select
 
 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Copy
 
End Sub

El problema es que aunque tengo un buen ordenador, se queda como pillada/congelada y tarda bastante, unos 8 - 9 segundos y creo que no es para tanto. Parece que donde mas tarda en eliminar las columnas.

¿Existe alguna forma de optimizarla?

Espero que podáis ayudarme,
Gracias de antemano.
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: 1.134
Oro
Ha mantenido su posición en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Macro VBA muy lenta

Publicado por Antoni Masana (498 intervenciones) el 22/05/2018 07:41:59
Empecemos por concretar un detalle no se que datos tienes en la hoja y por que hace lo que haces, lo cual hace difícil decir que esta mal o mejor dicho que se puede mejorar.

Una forma de saber donde va lento es haciendo esto, registra el tiempo en varios pasos y al final muestra lo que tarda en cada uno de elllos.

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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
Sub Cambio_diseño_()
'

' Cambio_diseño_ Macro

' Esta macro da formato para pegar el cambio de diseño en el correo

'

' Acceso directo: CTRL+l

'

' ---&--- Paso - 1

P1=Timer
 
' Empezamos copiando lo que viene de AL2

    Range("AL2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ' ActiveWindow.LargeScroll ToRight:=-1

    Range("C2").Select
    ActiveSheet.Paste
'

' ---&--- Paso - 2

P2=Timer
 
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:M").Select
    Selection.Delete Shift:=xlToLeft
    Columns("K:AD").Select
    Selection.Delete Shift:=xlToLeft
 
'

' ---&--- Paso - 3

P3=Timer
 
    Range("A1:J1").Select
    Selection.Font.Bold = True
 
    ' Range("A1:J3").Select   ' TENEMOS QUE SELECINAR HASTA EL ÚLTIMO, NO SOLAMENTE 3

 
'    Set a = Range("A1", Range("A1").End(xlDown))

'    Set b = Range("E1", Range("E1").End(xlDown))

'    Union(a, b).Select

 
'

' ---&--- Paso - 4

P4=Timer
 
    a = Range("A1:J1", Range("A1").End(xlDown)).Select
 
 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Copy
 
P5=Timer
MsgBox "Paso - 1: " & P2 - P1 & VbCrLf & _
       "Paso - 2: " & P3 - P2 & VbCrLf & _
       "Paso - 3: " & P4 - P3 & VbCrLf & _
       "Paso - 4: " & P5 - P4
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