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
Códigos del Módulo
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


0