Sub CargaSKUyFechExp_Ascendente()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim Ref As Long, Numeracion As Long
Dim InventarioData As Variant
Dim i As Long, LastRowWS1 As Long
Dim BodegaVirtual As String, DescripcionPropietario As String
Dim FechExP As Variant, UDM As String
Dim PrevBodegaVirtual As String, PrevUDM As String
Dim BatchSize As Long, StartRow As Long, EndRow As Long
Dim Block As Long, TotalBlocks As Long
' Desactivar actualizaciones de pantalla, cálculos automáticos y eventos
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
' Limpieza inicial de los rangos en la hoja "Inventario"
With Worksheets("Inventario") .Range("E3:XFC76").ClearContents .Range("B6:D76").ClearContents End With
' Llamada a la función FechaExpiracionAscendente (suponiendo que optimizada)
Call FechaExpiracionAscendente
' Referencias a hojas de trabajo
Set WS1 = Worksheets("Report Saldo") Set WS2 = Worksheets("Inventario")
' Obtener la última fila con datos en WS1 (columna A)
LastRowWS1 = WS1.Cells(WS1.Rows.Count, 1).End(xlUp).Row
' Definir el tamaño del bloque
BatchSize = Application.WorksheetFunction.RoundUp((LastRowWS1 - 1) / 10, 0) ' Dividido en 10 partes
' Inicializar variables de control
Ref = 6
Numeracion = 0
PrevBodegaVirtual = ""
PrevUDM = ""
' Procesar datos por lotes
TotalBlocks = 10 ' Número de bloques
For Block = 1 To TotalBlocks
' Calcular el rango del lote de datos
StartRow = (Block - 1) * BatchSize + 2 ' Comienza en la fila 2
EndRow = WorksheetFunction.Min(Block * BatchSize + 1, LastRowWS1) ' Ajustar al último lote
' Cargar el lote de datos en un array
InventarioData = WS1.Range("A" & StartRow & ":AI" & EndRow).Value
' Primer bucle: items y fechas de expiración
For i = 1 To UBound(InventarioData, 1)
BodegaVirtual = UCase(InventarioData(i, 9)) ' Columna "I"
DescripcionPropietario = UCase(InventarioData(i, 3)) ' Columna "C"
UDM = UCase(InventarioData(i, 10)) ' Columna "J"
' Verificar propietario y que la celda (3,3) no esté vacía
If DescripcionPropietario = UCase(WS2.Cells(3, 3).Value) And WS2.Cells(3, 3).Value <> "" Then
' Comparar solo si la combinación de BodegaVirtual y UDM cambió
If BodegaVirtual & UDM <> PrevBodegaVirtual & PrevUDM Then
' Escribir datos en WS2
WS2.Cells(Ref, 3).Value = BodegaVirtual
WS2.Cells(Ref, 4).Value = UDM
Numeracion = Numeracion + 1
WS2.Cells(Ref, 2).Value = Numeracion
Ref = Ref + 1
' Actualizar valores anteriores
PrevBodegaVirtual = BodegaVirtual
PrevUDM = UDM
End If
End If
Next i
' Segundo bucle: Sku por su descripción, origen y familia
Ref = 5
For i = 1 To UBound(InventarioData, 1)
DescripcionPropietario = UCase(InventarioData(i, 3)) ' Columna "C"
' Verificar propietario
If DescripcionPropietario = UCase(WS2.Cells(3, 3).Value) And WS2.Cells(3, 3).Value <> "" Then
' Comparar valores y escribir si es necesario
If UCase(WS2.Cells(4, Ref - 4).Value) <> UCase(InventarioData(i, 4)) Then ' Columna "D"
WS2.Cells(3, Ref).Value = InventarioData(i, 35) ' Columna "AI"
WS2.Cells(4, Ref).Value = InventarioData(i, 4) ' Columna "D"
WS2.Cells(5, Ref).Value = InventarioData(i, 5) ' Columna "E"
Ref = Ref + 4
End If
End If
Next i
' Liberar memoria entre bloques
Erase InventarioData
Next Block
' Restaurar configuraciones de Excel
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub
