Descontar Pedidos del inventario: Proceso muy lento
Publicado por Juan (200 intervenciones) el 03/04/2021 08:59:07
Hola Estimados, tengo una macro que de los pedidos de clientes que están en la hoja (“Pedidos”) descuenta cantidades de la tabla Inventario que están en la hoja (“Inventario”), estos descuentos tienen sus criterios que comparan ambas hojas: tienen que ser el mismo ALMACEN, ARTICULO, y el STATUS INVENTARIO debe ser solo Stock Liberado, además en los pedidos los artículos tienen una tolerancia de días de expiración que deben estar dentro del rango de fecha de expiración del articulo disponible en Inventario (Ejem: el cliente pide un artículo que su fecha de expiración no sea menor a 30 días).
El código ya está realizado, pero el problema es que es demasiado lento el proceso, sin formulas la carga tarda como 90 segundos, pero con fórmulas en el archivo original demora hasta 4 minutos. Me parece que el problema radica en el bucle. Ojalá pudieran ayudarme con una mejora en el código. Adjunto Archivo para mejor observación, los campos claves del código están relacionados con colores en las hojas para mejor identificación.
El código ya está realizado, pero el problema es que es demasiado lento el proceso, sin formulas la carga tarda como 90 segundos, pero con fórmulas en el archivo original demora hasta 4 minutos. Me parece que el problema radica en el bucle. Ojalá pudieran ayudarme con una mejora en el código. Adjunto Archivo para mejor observación, los campos claves del código están relacionados con colores en las hojas para mejor identificación.
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
Private Sub Informe_Click()
Dim ORD#, Asig#, AsigPend#, PICK#, InvAsig#, Inv#, RebajaInv#, FILAA&, FILA1&, old&, FilaB&, FilaC&Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim Max, AlmacenP, CodigoArticuloP, VencCorteP, AlmacenInv, CodigoArticuloInv, ExpiracionArtInv, StatusInv
Dim Almacen, Articulo, StockAsig
Dim Cell As Range
Dim Celda As Range
'Descontar en inventario la demanda de Articulos AsignadosWorksheets("Pedidos").Range("AQ2:AQ9000").Value = Empty
Worksheets("Pedidos").Range("AR2:AR9000").Value = Empty
Worksheets("Pedidos").Range("AS2:AS9000").Value = Empty
Worksheets("Inventario").Range("O2:O9000").Value = Empty
With Application
.ScreenUpdating = False
old = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Application.Calculation = xlAutomatic
Set WS1 = Worksheets("Pedidos")
Set WS2 = Worksheets("Inventario")
FilaB = 2While WS1.Cells(FilaB, 9).Value <> ""
FilaB = FilaB + 1
Wend
FilaC = 2While WS2.Cells(FilaC, 3).Value <> ""
FilaC = FilaC + 1
Wend
For Each Celda In WS2.Range("A2:A" & FilaC - 1)
Celda.Offset(, 14).Value = Celda.Offset(, 6).Value
Next
Inv = 0#
RebajaInv = 0#
Asig = 0#
AsigPend = 0#
For Each Cell In WS1.Range("A2:A" & FilaB - 1)
AlmacenP = Cell.Offset(, 0).Value
CodigoArticuloP = Cell.Offset(, 8).Value
VencCorteP = Cell.Offset(, 10).Value + Cell.Offset(, 3).Value
For Each Celda In WS2.Range("A2:A" & FilaC - 1)
AlmacenInv = Celda.Offset(, 0).Value
CodigoArticuloInv = Celda.Offset(, 2).Value
ExpiracionArtInv = Celda.Offset(, 8).Value
StatusInv = Celda.Offset(, 13).Value
If AlmacenP = AlmacenInv And CodigoArticuloP = CodigoArticuloInv And _
VencCorteP <= ExpiracionArtInv And StatusInv = "STock Lib" Then
Cell.Offset(, 43).Value = VencCorteP
Cell.Offset(, 44).Value = ExpiracionArtInv
If Cell.Offset(, 11).Value <= Celda.Offset(, 14).Value And Cell.Offset(, 42).Value = Empty Then
Inv = Celda.Offset(, 14).Value
Asig = Cell.Offset(, 11).Value
RebajaInv = Inv - Asig
Celda.Offset(, 14).Value = RebajaInv
Cell.Offset(, 42).Value = Asig
Exit For
ElseIf Celda.Offset(, 14).Value > 0 And Cell.Offset(, 11).Value > Celda.Offset(, 14).Value And _
Cell.Offset(, 42).Value = Empty Then
Inv = Celda.Offset(, 14).Value
Asig = InvRebajaInv = Inv - Asig
Celda.Offset(, 14).Value = RebajaInv
Cell.Offset(, 42).Value = Asig
ElseIf Celda.Offset(, 14).Value > 0 And Cell.Offset(, 11).Value > Cell.Offset(, 42).Value And _
Celda.Offset(, 14).Value <= (Cell.Offset(, 11).Value - Cell.Offset(, 42).Value) And _
Cell.Offset(, 42).Value <> Empty Then
Inv = Celda.Offset(, 14).Value
AsigPend = Cell.Offset(, 11).Value - Cell.Offset(, 42).Value
Asig = (AsigPend + Inv) - AsigPend
RebajaInv = Asig - Inv
Celda.Offset(, 14).Value = RebajaInv
Cell.Offset(, 42).Value = Cell.Offset(, 42).Value + Asig
If Cell.Offset(, 11).Value = Cell.Offset(, 42).Value Then
Exit For
End If
ElseIf Celda.Offset(, 14).Value > 0 And Cell.Offset(, 11).Value > Cell.Offset(, 42).Value And _
Celda.Offset(, 14).Value > (Cell.Offset(, 11).Value - Cell.Offset(, 42).Value) And _
Cell.Offset(, 42).Value <> Empty Then
Inv = Celda.Offset(, 14).Value
AsigPend = Cell.Offset(, 11).Value - Cell.Offset(, 42).Value
Asig = (AsigPend + Inv) - Inv
RebajaInv = Inv - Asig
Celda.Offset(, 14).Value = RebajaInv
Cell.Offset(, 42).Value = Cell.Offset(, 42).Value + Asig
If Cell.Offset(, 11).Value = Cell.Offset(, 42).Value Then
Exit For
End If
End If
RebajaInv = 0#
Inv = 0#
Asig = 0#
AsigPend = 0#
End If
Next
Next
End Sub
- PreAsignacion.rar(2,0 MB)
Valora esta pregunta
0