Excel - Excel Lento

 
Vista:

Excel Lento

Publicado por stevenson lopez giraldo (2 intervenciones) el 29/08/2017 15:21:34
Cordial saludo

Tengo 3 código en un excel, 1 en un userform y 2 en un módulo, para un archivo que tiene mas de 400 mil filas y 15 columnas. Los códigos realizan el proceso que quiero, que es hacer un buscarv para encontrar datos de una base, pasar lo encontrado a otra hoja y luego eliminarlos de la base de datos pero este proceso bloquea la aplicación y hasta el pc. Como me pueden ayudar para que esto no suceda

Codigo del userform

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
Private Sub CommandButton1_Click()
 
 
Application. ScreenUpdating = False
 
Application. Calculation = xlCalculationManual
 
Application. EnableEvents = False
 
ActiveSheet. DisplayPageBreaks = False
 
 
If OptionButton1 = True Then
 
Transaccion = "Salida"
 
Sheets("BD"). Rows(lugar). Delete
 
Else
 
Transaccion = "Entrada"
 
End If
 
 
Unload Me
 
 
Application. ScreenUpdating = True
 
Application. Calculation = xlCalculationAutomatic
 
Application. EnableEvents = True
 
ActiveSheet. DisplayPageBreaks = True
 
Application. CutCopyMode = False
 
 
End Sub

Códigos del Módulo

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
Option Explicit
Public Transaccion As String
Public lugar As Variant
 
Public Sub TransferirDatosOtraHoja()
Dim Cliente As String
Dim CodigoCaja As String
Dim Ubicacion As String
Dim Descripcion As String
Dim UltimaFila As Long
Dim cont As Long
Dim UltimaFilaHoja As Long
 
Application. ScreenUpdating = False
Application. Calculation = xlCalculationManual
Application. EnableEvents = False
ActiveSheet. DisplayPageBreaks = False
 
TRANSACCIÓN. Show
 
UltimaFila = Sheets("Transacciones"). Range("B" & Rows. Count). End(xlUp). Row
For cont = 9 To UltimaFila
Cliente = Sheets("Transacciones"). Cells(cont, 2)
CodigoCaja = Sheets("Transacciones"). Cells(cont, 3)
Ubicacion = Sheets("Transacciones"). Cells(cont, 4)
Descripcion = Sheets("Transacciones"). Cells(cont, 5)
UltimaFilaHoja = Sheets("HT"). Range("A" & Rows. Count). End(xlUp). Row
Sheets("HT"). Cells(UltimaFilaHoja + 1, 1) = Cliente
Sheets("HT"). Cells(UltimaFilaHoja + 1, 2) = CodigoCaja
Sheets("HT"). Cells(UltimaFilaHoja + 1, 3) = Ubicacion
Sheets("HT"). Cells(UltimaFilaHoja + 1, 4) = Descripcion
Sheets("HT"). Cells(UltimaFilaHoja + 1, 5) = Transaccion
Sheets("HT"). Cells(UltimaFilaHoja + 1, 6) = Now
Next cont
Sheets("transacciones"). Range("B9:H" & UltimaFila). Clear
MsgBox "Transacción realizada exitosamente", vbInformation, "TRANSACCIONES"
Application. ScreenUpdating = True
Application. Calculation = xlCalculationAutomatic
Application. EnableEvents = True
ActiveSheet. DisplayPageBreaks = True
Application. CutCopyMode = False
 
End Sub
 
Sub BusquedaVertical()
Dim cont As Long
Dim UltLinea As Long
Dim Ubicacion As Variant
Dim Descripcion As Variant
Dim Cliente As Variant
Dim Codigo As Variant
Dim rango As Variant
Dim Ultifilarango As Long
 
Application. ScreenUpdating = False
Application. Calculation = xlCalculationManual
Application. EnableEvents = False
ActiveSheet. DisplayPageBreaks = False
 
Ultifilarango = Sheets("BD"). Range("A" & Rows. Count). End(xlUp). Row
 
UltLinea = Sheets("Transacciones"). Range("C" & Rows. Count). End(xlUp). Row
Set rango = Sheets("BD"). Range("A2:H" & Ultifilarango)
For cont = 9 To UltLinea
Codigo = Sheets("Transacciones"). Cells(cont, 3)
Ubicacion = Application. VLookup(Codigo, rango, 3, False)
Descripcion = Application. VLookup(Codigo, rango, 5, False)
Cliente = Application. VLookup(Codigo, rango, 2, False)
Lugar = Application. Match(CLng(Codigo), Sheets("BD"). Range("A1:A" & Ultifilarango), 0)
If IsError(Ubicacion) Then
Ubicacion = 0
Descripcion = 0
Cliente = 0
End If
Sheets("Transacciones"). Cells(cont, 4) = Ubicacion
Sheets("Transacciones"). Cells(cont, 5) = Descripcion
Sheets("Transacciones"). Cells(cont, 2) = Cliente
Next cont
 
Application. ScreenUpdating = True
Application. Calculation = xlCalculationAutomatic
Application. EnableEvents = True
ActiveSheet. DisplayPageBreaks = True
Application. CutCopyMode = False
 
End Sub
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

Excel Lento

Publicado por JuanC (1237 intervenciones) el 29/08/2017 19:08:49
si querés pasamelo por email y lo miro...
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

Excel Lento

Publicado por Antoni Masana (2477 intervenciones) el 30/08/2017 07:12:55
Un par de sugerencias:

Probablemente el código repita en exceso la lectura y en una sola pasada se podría optimizar pero esto JuanC ya te dira el que y el como.
Lo otro es poner dentro de los bucles algún DoEvents. Esto evita que al ejecutar una macro que tarda cierto tiempo no tome el control absoluto de la máquina.

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
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

Excel Lento

Publicado por Antoni Masana (2477 intervenciones) el 30/08/2017 11:51:33
Mirando el código así a lo tonto he visto varias cosas. En primer lugar así es mas fácil de leer:

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
' ---------------------------------------------------------------------------
' ---&---  Boton - Aceptar
' ---------------------------------------------------------------------------
 
Private Sub CommandButton1_Click()
    Application. ScreenUpdating = False
    Application. Calculation = xlCalculationManual
    Application. EnableEvents = False
    ActiveSheet. DisplayPageBreaks = False
 
    If OptionButton1 = True Then
        Transaccion = "Salida"
        Sheets("BD"). Rows(lugar). Delete
    Else
        Transaccion = "Entrada"
    End If
 
    Application. ScreenUpdating = True
    Application. Calculation = xlCalculationAutomatic
    Application. EnableEvents = True
    ActiveSheet. DisplayPageBreaks = True
    Application. CutCopyMode = False
 
    Unload Me
End Sub


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
Option Explicit
Public Transaccion As String
Public lugar As Variant
 
' ---------------------------------------------------------------------------
' ---&---  Transferir Datos a Otra Hoja
' ---------------------------------------------------------------------------
 
Public Sub TransferirDatosOtraHoja()
    Dim UltimaFila As Long, cont As Long, UltimaFilaHoja As Long
 
    Application. ScreenUpdating = False
    Application. Calculation = xlCalculationManual
    Application. EnableEvents = False
    ActiveSheet. DisplayPageBreaks = False
 
    TRANSACCIÓN. Show
 
    UltimaFila     = Sheets("Transacciones"). Range("B" & Rows. Count). End(xlUp). Row
    UltimaFilaHoja = Sheets("HT"). Range("A" & Rows. Count). End(xlUp). Row
 
    For cont = 9 To UltimaFila
        UltimaFilaHoja = UltimaFilaHoja + 1 : DoEvents
 
        Sheets("HT"). Cells(UltimaFilaHoja + 1, 1) = Sheets("Transacciones"). Cells(cont, 2)
        Sheets("HT"). Cells(UltimaFilaHoja + 1, 2) = Sheets("Transacciones"). Cells(cont, 3)
        Sheets("HT"). Cells(UltimaFilaHoja + 1, 3) = Sheets("Transacciones"). Cells(cont, 4)
        Sheets("HT"). Cells(UltimaFilaHoja + 1, 4) = Sheets("Transacciones"). Cells(cont, 5)
        Sheets("HT"). Cells(UltimaFilaHoja + 1, 5) = Transaccion
        Sheets("HT"). Cells(UltimaFilaHoja + 1, 6) = Now
    Next cont
 
    Sheets("transacciones"). Range("B9:H" & UltimaFila). Clear
    MsgBox "Transacción realizada exitosamente", vbInformation, "TRANSACCIONES"
 
    Application. ScreenUpdating = True
    Application. Calculation = xlCalculationAutomatic
    Application. EnableEvents = True
    ActiveSheet. DisplayPageBreaks = True
    Application. CutCopyMode = False
End Sub
 
' ---------------------------------------------------------------------------
' ---&---  Busqueda Vertical
' ---------------------------------------------------------------------------
 
Sub BusquedaVertical()
    Dim cont As Long, UltLinea As Long, Ubicacion As Variant, _
        Descripcion As Variant, Cliente As Variant, Codigo As Variant
        rango As Variant, Ultifilarango As Long
 
    Application. ScreenUpdating = False
    Application. Calculation = xlCalculationManual
    Application. EnableEvents = False
    ActiveSheet. DisplayPageBreaks = False
 
    Ultifilarango = Sheets("BD"). Range("A" & Rows. Count). End(xlUp). Row
 
    UltLinea = Sheets("Transacciones"). Range("C" & Rows. Count). End(xlUp). Row
    Set rango = Sheets("BD"). Range("A2:H" & Ultifilarango)
 
    For cont = 9 To UltLinea
        Codigo = Sheets("Transacciones"). Cells(cont, 3)
        Ubicacion   = Application. VLookup(Codigo, rango, 3, False)
        Descripcion = Application. VLookup(Codigo, rango, 5, False)
        Cliente     = Application. VLookup(Codigo, rango, 2, False)
        Lugar       = Application. Match(CLng(Codigo), Sheets("BD"). Range("A1:A" & Ultifilarango), 0)
 
        If IsError(Ubicacion) Then
            Ubicacion = 0
            Descripcion = 0
            Cliente = 0
        End If
        Sheets("Transacciones"). Cells(cont, 4) = Ubicacion
        Sheets("Transacciones"). Cells(cont, 5) = Descripcion
        Sheets("Transacciones"). Cells(cont, 2) = Cliente
    Next cont
 
    Application. ScreenUpdating = True
    Application. Calculation = xlCalculationAutomatic
    Application. EnableEvents = True
    ActiveSheet. DisplayPageBreaks = True
    Application. CutCopyMode = False
End Sub

Lo primero que veo es que estos tres procesos no tiene nada que ver uno con el otro. El primero lo ejecuta un BUTTON o al menos eso de deduce por el nombre. Si en lugar de dejar el nombre por defecto cambias el nombre por ejemplo como: Boton_Aceptar queda más claro que boton lo ejecuta.

Seguimos el proceso TransferirDatosOtraHoja están modificadas las líneas de la 19 a la 31, simplifica el movimiento y el DoEvents evita el "bloqueo".

El último proceso es el más raro, todo sobre todo el código del For / Next
En primer lugar ¿donde lo busca? No veo cual es la hoja activa.
Si la hoja activa tiene 400.000 líneas para saber si un código existe tiene que recorrerla 3 veces, que es casi lo mismo que buscarlo en 1.200.000 líneas.

Rectifico en parte lo expuesto en el párrafo anterior, no son 3 sino 4 veces que busca en la hoja BD, incluida en el rango y esto no es óptimo.

Creo que a falta de probarlo el trozo del For / Next es mejor así y no olvides el DoEvents:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub BusquedaVertical()
    ...
    Set rango = Sheets("BD"). Range("A2:A" & Ultifilarango)
    For cont = 9 To UltLinea
        Codigo = Sheets("Transacciones"). Cells(cont, 3) : DoEvents
        Lugar = Application. Match(CLng(Codigo), rango, 0)
        If IsError(Lugar) Then
            Sheets("Transacciones"). Cells(cont, 4) = 0
            Sheets("Transacciones"). Cells(cont, 5) = 0
            Sheets("Transacciones"). Cells(cont, 2) = 0
        else
            Sheets("Transacciones"). Cells(cont, 4) = Sheets("BD").Cells(Lugar, 3)
            Sheets("Transacciones"). Cells(cont, 5) = Sheets("BD").Cells(Lugar, 5)
            Sheets("Transacciones"). Cells(cont, 2) = Sheets("BD").Cells(Lugar, 2)
        end if
    Next
    ...
End Sub

Si le envias el libro a JuanC el tambien te podra ayudar, ten en cuenta que todo lo que expongo es teórico y no está probado y pueden haber errores.

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
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

Excel Lento

Publicado por Antoni Masana (2477 intervenciones) el 30/08/2017 11:57:03
Y una más en el colmo de la optimización:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub BusquedaVertical()
    ...
    Set rango = Sheets("BD"). Range("A2:A" & Ultifilarango)
 
    With Sheets("Transacciones")
        For cont = 9 To UltLinea
            Codigo = .Cells(cont, 3) : DoEvents
            Lugar = Application. Match(CLng(Codigo), rango, 0)
            If IsError(Lugar) Then
                .Cells(cont, 4) = 0
                .Cells(cont, 5) = 0
                .Cells(cont, 2) = 0
            else
                .Cells(cont, 4) = Sheets("BD").Cells(Lugar, 3)
                .Cells(cont, 5) = Sheets("BD").Cells(Lugar, 5)
                .Cells(cont, 2) = Sheets("BD").Cells(Lugar, 2)
            end if
        Next
    End With
    ...
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

Excel Lento

Publicado por stevenson lopez giraldo (1 intervención) el 04/09/2017 23:54:27
Cordial saludo,
sus aportes han sido valiosos y me han ayudado a realizar correcciones a partir de sus sugerencia y en ese orden de ideas he identificado cual es la linea que me vuelve lento el trabajo pero no se como reemplazarla.

1
2
3
4
5
6
If OptionButton1 = True Then
    Transaccion = "Salida"
    Sheets("BD"). Rows(lugar). Delete
Else
    Transaccion = "Entrada"
End If

en las lineas anteriores encontramos la siguiente: Sheets("BD"). Rows(lugar). Delete
esta linea es la que bloquea el equipo o pone a trabajar el excel lento.

que otra instrucción puedo usar para que al momento de elegir la opción salida en el optionbutton1, elimine el registro que encontró en la posición (lugar)

de antemano muchas gracias
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