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 » Cómo hacer que esta macro funcione más rápido

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

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

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