Visual Basic para Aplicaciones - Cómo hacer que esta macro funcione más rápido

Life is soft - evento anual de software empresarial
   
Vista:

Cómo hacer que esta macro funcione más rápido

Publicado por alexis (1 intervención) el 02/01/2015 03:50:46
Tengo una macro que toma datos de 2 tablas (una para los proveedores y la otra para todos los ítems que se compran). Luego hace una tabla para cada proveedor con sus ítems y calcula algunos datos (me interesa que estos datos queden como fórmula y no como un valor, de manera que se pueda modificar los datos y obtener nuevos valores sin ejecutar la macro nuevamente).
El problema es que tarda algo así como 20 minutos en hacer todo. Quisiera saber si hay algo de lo que hace que se pueda hacer más rápido. Desde ya muchas gracias. Aquí les dejo el código:
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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
Sub calcularPOQ()
 
  Set libroBase = Workbooks("Cálculo POQ.xlsm")
  Set wsDatosProv = libroBase.Worksheets("Datos por prov.")
  Set wsDatosItems = libroBase.Worksheets("Datos")
 
  Dim matrizProv As Variant
  Dim matrizDatos As Variant
 
  wsDatosProv.Activate
  Call limpiarFiltros 'Módulo2
  'Paso los valores de la TablaProveedores a la matrizProv
  matrizProv = Range("TablaProveedores") 'Primer índice: 1
 
  wsDatosItems.Activate
  Call limpiarFiltros
  'Paso los valores de la TablaPOQ a la matrizDatos
  matrizDatos = Range("TablaPOQ") 'Primer índice: 1
 
  'Libro nuevo con una hoja
  Set libroSalida = Application.Workbooks.Add(1)
 
  libroSalida.Title = "Cálculo POQ " & Format(Date, "dd-mm-yyyy")
  libroSalida.Subject = "Cálculo POQ óptimo por proveedor"
  'Se guarda en la misma carpeta que el archivo base
  libroSalida.SaveAs Filename:=libroBase.Path & "\" & libroSalida.Title
 
  libroSalida.Worksheets(1).Name = "Proveedores"
  Set wsPOQxProv = libroSalida.Worksheets("Proveedores")
 
  For iProv = 1 To UBound(matrizProv)
  contador = 0 'Cuenta la cantidad de filas para cada tabla de proveedor
 
  If matrizProv(iProv, 2) = "Importado" Then
  'Define en qué fila se va a escribir de acuerdo a la última fila escrita hasta el momento
  'supIzq es la esquina superior izquierda para cada tabla de proveedor. A partir de ahí... offset
  If wsPOQxProv.UsedRange.Rows.Count = 1 Then
  Set supIzq = wsPOQxProv.Range("A1")
  Else
  Set supIzq = libroSalida.Worksheets(1).Range("A" & wsPOQxProv.UsedRange.Rows.Count + 3)
  End If
 
  'Títulos del encabezado de cada tabla
  supIzq.Offset(0, 0).Value = "Proveedor"
  supIzq.Offset(0, 2).Value = "Carga"
  supIzq.Offset(0, 3).Value = "Costo"
  supIzq.Offset(0, 4).Value = "EXW"
  supIzq.Offset(0, 5).Value = "KT"
  supIzq.Offset(0, 6).Value = "i"
  supIzq.Offset(0, 14).Value = "sc adq."
  supIzq.Offset(0, 15).Value = "sc O/C"
  supIzq.Offset(0, 16).Value = "sc stock"
  supIzq.Offset(0, 17).Value = "sc Total"
  'Valores que van abajo de los títulos
  supIzq.Offset(1, 0).Value = matrizProv(iProv, 1)
  supIzq.Offset(1, 2).Value = matrizProv(iProv, 8)
  supIzq.Offset(1, 3).Value = matrizProv(iProv, 9)
  supIzq.Offset(1, 4).Value = matrizProv(iProv, 7)
  supIzq.Offset(1, 5).Value = matrizProv(iProv, 10)
  'supIzq.Offset(1, 6).Value = "" 'Se calculan más adelante
  'supIzq.Offset(1, 14).Value = ""
  'supIzq.Offset(1, 15).Value = ""
  'supIzq.Offset(1, 16).Value = ""
  'supIzq.Offset(1, 17).Value = ""
  'Títulos de la tabla
  supIzq.Offset(2, 0).Value = "Producto"
  supIzq.Offset(2, 1).Value = "Descripcion"
  supIzq.Offset(2, 2).Value = "Proveedor"
  supIzq.Offset(2, 3).Value = "CM"
  supIzq.Offset(2, 4).Value = "FOB"
  supIzq.Offset(2, 5).Value = "Nac."
  supIzq.Offset(2, 6).Value = "i [%]"
  supIzq.Offset(2, 7).Value = "b*"
  supIzq.Offset(2, 8).Value = "K"
  supIzq.Offset(2, 9).Value = "Qo"
  supIzq.Offset(2, 10).Value = "POQ"
  supIzq.Offset(2, 11).Value = "Co"
  supIzq.Offset(2, 12).Value = "sc FOB"
  supIzq.Offset(2, 13).Value = "POQ"
  supIzq.Offset(2, 14).Value = "Adq."
  supIzq.Offset(2, 15).Value = "O/C"
  supIzq.Offset(2, 16).Value = "Stock"
  supIzq.Offset(2, 17).Value = "Total"
 
  'Valores de la tabla
  For iDatos = 1 To UBound(matrizDatos)
 
  If (matrizDatos(iDatos, 3) = matrizProv(iProv, 1) And matrizDatos(iDatos, 10) <> 0 And matrizDatos(iDatos, 13) <> 0) Then 'Si el proveedor coincide...
  supIzq.Offset(3 + contador, 0).Value = matrizDatos(iDatos, 1) 'Código ítem
  supIzq.Offset(3 + contador, 1).Value = matrizDatos(iDatos, 2) 'Descripción ítem
  supIzq.Offset(3 + contador, 2).Value = matrizDatos(iDatos, 3) 'Nombre proveedor
  supIzq.Offset(3 + contador, 3).Value = matrizDatos(iDatos, 10) 'Consumo medio
  supIzq.Offset(3 + contador, 4).Value = matrizDatos(iDatos, 13) 'FOB (precio proveedor)
  supIzq.Offset(3 + contador, 5).Value = matrizDatos(iDatos, 18) 'Derechos de importación
  supIzq.Offset(3 + contador, 6).Value = matrizDatos(iDatos, 15) 'Tasa i
  supIzq.Offset(3 + contador, 7).FormulaR1C1 = "=RC[-3]*(1+RC[-2])" 'b*
  'supIzq.Offset(3 + contador, 8).FormulaR1C1 = "" 'K
  supIzq.Offset(3 + contador, 9).FormulaR1C1 = "=SQRT(2*RC[-1]*12*RC[-6]/RC[-3]/RC[-2])" 'Q óptimo
  supIzq.Offset(3 + contador, 10).FormulaR1C1 = "=RC[-1]/RC[-7]*30" 'POQ [días]
  supIzq.Offset(3 + contador, 11).FormulaR1C1 = "=RC[-4]+RC[-2]*RC[-4]*RC[-5]/2/12/RC[-8]+RC[-3]/RC[-2]" 'Costo óptimo
  supIzq.Offset(3 + contador, 12).FormulaR1C1 = "=RC[-1]/RC[-8]-1" 'sobrecosto FOB
  supIzq.Offset(3 + contador, 13).FormulaR1C1 = "=RC[-4]/RC[-10]" 'POQ [meses]
  supIzq.Offset(3 + contador, 14).FormulaR1C1 = "=RC[-7]" 'Costo adquisición
  supIzq.Offset(3 + contador, 15).FormulaR1C1 = "=RC[-7]/RC[-6]" 'Costo O/C
  supIzq.Offset(3 + contador, 16).FormulaR1C1 = "=1/2*RC[-7]*RC[-9]*RC[-10]/12/RC[-13]" 'Costo stock
  supIzq.Offset(3 + contador, 17).FormulaR1C1 = "=SUM(RC[-3]:RC[-1])" 'Costo Total
 
  contador = contador + 1
  End If
 
  If contador <> 0 Then
  'Quedé acá
  End If
  Next iDatos
 
  'Esta instrucción es para que vaya bajando el cursor mientras se llena la planilla. Puramente visual
  supIzq.Offset(3 + contador, 0).Activate
 
  'Fila de totales de cada tabla
  'supIzq.Offset(3 + contador, 0).Value = "" 'Código ítem
  'supIzq.Offset(3 + contador, 1).Value = "" 'Descripción ítem
  'supIzq.Offset(3 + contador, 2).Value = "" 'Nombre proveedor
  'supIzq.Offset(3 + contador, 3).Value = "" 'Consumo medio
  supIzq.Offset(3 + contador, 4).FormulaR1C1 = "=SUMPRODUCT(R[-" & contador & "]C:R[-1]C,R[-" & contador & "]C[5]:R[-1]C[5])" 'FOB (precio proveedor)
  'supIzq.Offset(3 + contador, 5).Value = "" 'Derechos de importación
  'supIzq.Offset(3 + contador, 6).Value = "" 'Tasa i
  supIzq.Offset(3 + contador, 7).FormulaR1C1 = "=SUMPRODUCT(R[-" & contador & "]C[-4]:R[-1]C[-4],R[-" & contador & "]C:R[-1]C)" 'b*
  supIzq.Offset(3 + contador, 8).FormulaR1C1 = "=SUM(R[-" & contador & "]C:R[-1]C)" 'K
  'supIzq.Offset(3 + contador, 9).FormulaR1C1 = "" 'Q óptimo
  'supIzq.Offset(3 + contador, 10).FormulaR1C1 = "" 'POQ [días]
  supIzq.Offset(3 + contador, 11).FormulaR1C1 = "=SUMPRODUCT(R[-" & contador & "]C[-2]:R[-1]C[-2],R[-" & contador & "]C:R[-1]C)" 'Costo óptimo
  supIzq.Offset(3 + contador, 12).FormulaR1C1 = "=RC[-1]/RC[-8]-1" 'sobrecosto FOB
  'supIzq.Offset(3 + contador, 13).FormulaR1C1 = "" 'POQ [meses]
  supIzq.Offset(3 + contador, 14).FormulaR1C1 = "=SUMPRODUCT(R[-" & contador & "]C[-5]:R[-1]C[-5],R[-" & contador & "]C:R[-1]C)" 'Costo adquisición
  supIzq.Offset(3 + contador, 15).FormulaR1C1 = "=SUMPRODUCT(R[-" & contador & "]C[-6]:R[-1]C[-6],R[-" & contador & "]C:R[-1]C)" 'Costo O/C
  supIzq.Offset(3 + contador, 16).FormulaR1C1 = "=SUMPRODUCT(R[-" & contador & "]C[-7]:R[-1]C[-7],R[-" & contador & "]C:R[-1]C)" 'Costo stock
  supIzq.Offset(3 + contador, 17).FormulaR1C1 = "=SUMPRODUCT(R[-" & contador & "]C[-8]:R[-1]C[-8],R[-" & contador & "]C:R[-1]C)" 'Costo Total
 
  'Sobrecostos
  supIzq.Offset(1, 14).FormulaR1C1 = "=R[" & contador + 2 & "]C/R[" & contador + 2 & "]C[-10]-1" 'sobrecosto adquisición
  supIzq.Offset(1, 15).FormulaR1C1 = "=R[" & contador + 2 & "]C/R[" & contador + 2 & "]C[-11]" 'sobreCosto O/C"
  supIzq.Offset(1, 16).FormulaR1C1 = "=R[" & contador + 2 & "]C/R[" & contador + 2 & "]C[-12]" 'sobrecosto stock
  supIzq.Offset(1, 17).FormulaR1C1 = "=R[" & contador + 2 & "]C/R[" & contador + 2 & "]C[-13]-1" 'sobrecosto Total
 
  supIzq.Offset(1, 14).NumberFormat = "0.0%" 'sobrecosto adquisición
  supIzq.Offset(1, 15).NumberFormat = "0.0%" 'sobreCosto O/C"
  supIzq.Offset(1, 16).NumberFormat = "0.0%" 'sobrecosto stock
  supIzq.Offset(1, 17).NumberFormat = "0.0%" 'sobrecosto Total
 
 
  For iK = 1 To contador
  supIzq.Offset(2 + iK, 8).FormulaR1C1 = "=RC[-5]*RC[-1]/R[" & (contador - iK + 1) & "]C[-1]*R[" & (-2 - iK + 1) & "]C[-3]" 'K por item
  Next iK
 
  End If
  Next iProv
 
  libroSalida.Save
  MsgBox "Ejecución finalizada"
 
  Beep
End Sub
1
2
3
4
5
Sub limpiarFiltros()
  If ActiveSheet.AutoFilterMode Or ActiveSheet.FilterMode Then
  ActiveSheet.ShowAllData
  End If
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