Private Sub Informe_Click()
Dim Almacen_Ped As String, Articul_Ped As Long, VencCor_Ped As Date, _
CantOrd_Ped As Long, CantAsg_Ped As Long, Codigo As String, _
Asignad_Ped As Long
Dim Almacen_Inv As String, Articul_Inv As Long, Expirac_Inv As Date, _
StatusI_Inv As String, Vaciado_Inv As Long, Asignar As Long
Dim Fila_Pedi As Long, Total_Pedi As Long, Almacen As String, _
Fila_Inve As Long, Total_Inve As Long, Puntero As Long
Dim Tab_Alm() As String, Tab_Reg() As Long, a As Long, Num As Byte, _
Registro As String
Dim WS_Pedi As Worksheet, _
WS_Inve As Worksheet, Inicio As Single, Old As Integer
Inicio = Timer
' ---&--- Limpieza
Set WS_Pedi = Worksheets("Pedidos") Set WS_Inve = Worksheets("Inventario")
WS_Pedi.Range("AQ2:AQ9000") = Empty WS_Pedi.Range("AR2:AR9000") = Empty WS_Pedi.Range("AS2:AS9000") = Empty WS_Inve.Range("O2:O9000") = Empty
With Application
.ScreenUpdating = False
Old = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
End With
' Call MaxDiaCorte
Application.Calculation = xlAutomatic
' ---&--- Cuenta las lines - Rellena la Columna P - Asigna Col 'G' a la 'O'
With WS_Inve
Total_Inve = 2
While .Cells(Total_Inve, "A") <> ""
.Cells(Total_Inve, "O") = .Cells(Total_Inve, "G")
.Cells(Total_Inve, "P") = Total_Inve
Total_Inve = Total_Inve + 1
Wend
DoEvents
End With
' ---&--- Ordena por: Almacen + Status + Articulo +Expira
Sheets("Inventario").Select With ActiveWorkbook.Worksheets("Inventario").Sort.SortFields .Clear
.Add2 Key:=Range("A2:A" & Total_Inve), SortOn:=xlSortOnValues, _ Order:=xlAscending, _
DataOption:=xlSortNormal
.Add2 Key:=Range("N2:N" & Total_Inve), SortOn:=xlSortOnValues, _ Order:=xlAscending, _
DataOption:=xlSortNormal
.Add2 Key:=Range("C2:C" & Total_Inve), SortOn:=xlSortOnValues, _ Order:=xlAscending, _
DataOption:=xlSortNormal
.Add2 Key:=Range("I2:I" & Total_Inve), SortOn:=xlSortOnValues, _ Order:=xlAscending, _
DataOption:=xlSortNormal
End With
With ActiveWorkbook.Worksheets("Inventario").Sort .SetRange Range("A1:P" & Total_Inve) .Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' ---&--- Busca el primer registro de cada almacen
Num = 0
Registro = "^"
For a = 2 To Total_Inve
If WS_Inve.Cells(a, "N") = "STock Lib" Then
If IsNumeric(WS_Inve.Cells(a, "A")) Then
Almacen = Str(WS_Inve.Cells(a, "A"))
Else
Almacen = WS_Inve.Cells(a, "A")
End If
If InStr(Registro, UCase(Almacen)) = 0 Then
Num = Num + 1
ReDim Preserve Tab_Alm(Num): Tab_Alm(Num) = UCase(Almacen)
ReDim Preserve Tab_Reg(Num): Tab_Reg(Num) = a
Registro = Registro & UCase(Almacen) & "^"
End If
End If
DoEvents
Next
' ---&--- Cuenta las filas de PEDIDOS
Total_Pedi = 2
While WS_Pedi.Cells(Total_Pedi, 9) <> ""
Total_Pedi = Total_Pedi + 1
DoEvents
Wend
' -----------------------------------------------------------------------
' ---&--- Proceso principal ---------------------------------------------
' -----------------------------------------------------------------------
For Fila_Pedi = 2 To Total_Pedi
With WS_Pedi
Almacen_Ped = .Cells(Fila_Pedi, "A")
Articul_Ped = .Cells(Fila_Pedi, "I")
VencCor_Ped = .Cells(Fila_Pedi, "K") + .Cells(Fila_Pedi, "D")
CantOrd_Ped = .Cells(Fila_Pedi, "L")
CantAsg_Ped = .Cells(Fila_Pedi, "AQ")
Asignad_Ped = CantOrd_Ped - CantAsg_Ped
' ---&--- Prepado el codigo de almacen para buscar en la tabla
If IsNumeric(.Cells(Fila_Pedi, "A")) Then
Codigo = Str(.Cells(Fila_Pedi, "A"))
Else
Codigo = .Cells(Fila_Pedi, "A")
End If
End With
DoEvents
' ---&--- Si no esta en el registro no lo busca en el inventario
If InStr(Registro, "^" & UCase(Codigo) & "^") > 0 Then
' ---&--- Busca la posición 1er registro inventario
For a = 1 To Num
If UCase(Codigo) = Tab_Alm(a) Then Puntero = Tab_Reg(a): Exit For
Next
' ---&--- Lee la hoja de Inventario
For Fila_Inve = Puntero To Total_Inve
With WS_Inve
Almacen_Inv = .Cells(Fila_Inve, "A") '0
Articul_Inv = .Cells(Fila_Inve, "C") '2
Expirac_Inv = .Cells(Fila_Inve, "I") '8
StatusI_Inv = .Cells(Fila_Inve, "N") '13
Vaciado_Inv = .Cells(Fila_Inve, "O") '14
End With
' ---&--- Finaliza si cambia de almacen _
El articulo es mayor que el que busco _
Si no es STock Lib
If Almacen_Ped <> Almacen_Inv Then Exit For
If Articul_Ped < Articul_Inv Then Exit For
If StatusI_Inv <> "STock Lib" Then Exit For
' --- Esta deltro de los rango
If Almacen_Ped = Almacen_Inv And _
Articul_Ped = Articul_Inv And VencCor_Ped <= Expirac_Inv And _
StatusI_Inv = "STock Lib" Then
WS_Pedi.Cells(Fila_Pedi, "AR") = VencCor_Ped
WS_Pedi.Cells(Fila_Pedi, "AS") = Expirac_Inv
' ---&--- Realiza la asignación si hay stock
If Vaciado_Inv > 0 Then
If Vaciado_Inv >= CantOrd_Ped - CantAsg_Ped Then
Asignar = CantOrd_Ped - CantAsg_Ped
WS_Inve.Cells(Fila_Inve, "O") = Vaciado_Inv - Asignar
WS_Pedi.Cells(Fila_Pedi, "AQ") = CantAsg_Ped + Asignar
Else
WS_Inve.Cells(Fila_Inve, "O") = 0
WS_Pedi.Cells(Fila_Pedi, "AQ") = CantAsg_Ped + Vaciado_Inv
End If
CantAsg_Ped = WS_Pedi.Cells(Fila_Pedi, "AQ")
If WS_Pedi.Cells(Fila_Pedi, "L") = WS_Pedi.Cells(Fila_Pedi, "AQ") Then
Exit For
End If
End If
End If
DoEvents
Next
End If
Next
' ---&--- Restaura el orden Anterior
Sheets("Inventario").Select With ActiveWorkbook.Worksheets("Inventario").Sort.SortFields .Clear
.Add2 Key:=Range("P2:P" & Total_Inve), SortOn:=xlSortOnValues, _ Order:=xlAscending, _
DataOption:=xlSortNormal
End With
With ActiveWorkbook.Worksheets("Inventario").Sort .SetRange Range("A1:P" & Total_Inve) .Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
WS_Inve.Columns("P:P").Select Selection.Delete Shift:=xlToLeft
WS_Inve.Range("A2").Select
MsgBox "Fin. " & Timer - Inicio
End Sub
