@JSDJSDCon gusto mi estimado
Para la opción 1:
Sub Surtirhastadondealcanse()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
Dim filaInicio As Integer: filaInicio = 4
Dim filaFin As Integer: filaFin = 7
Dim colInventario As Integer: colInventario = 2
Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C
Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I
Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L
Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M
Dim numClientes As Integer: numClientes = 3
Dim fila As Integer, i As Integer
For fila = filaInicio To filaFin
Dim inventario As Double
inventario = Val(ws.Cells(fila, colInventario).Value)
Dim solicitudes(1 To 3) As Double
Dim surtido(1 To 3) As Variant
Dim totalSurtido As Double: totalSurtido = 0
' Leer solicitudes
For i = 1 To numClientes
If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then
solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value)
Else
solicitudes(i) = 0
End If
surtido(i) = "POR FALTA STOCK"
Next i
' Surtir de acuerdo al inventario disponible
For i = 1 To numClientes
If solicitudes(i) > 0 Then
If inventario >= solicitudes(i) Then
surtido(i) = solicitudes(i)
inventario = inventario - solicitudes(i)
totalSurtido = totalSurtido + solicitudes(i)
ElseIf inventario > 0 Then
surtido(i) = inventario
totalSurtido = totalSurtido + inventario
inventario = 0
Else
surtido(i) = "POR FALTA STOCK"
End If
End If
Next i
' Escribir resultados en las columnas correspondientes para cada cliente
For i = 1 To numClientes
With ws.Cells(fila, colResultadoInicio + i - 1)
If surtido(i) = "POR FALTA STOCK" Then
.Value = surtido(i)
.Font.Color = vbRed
Else
.Value = surtido(i)
.Font.Color = vbBlack
End If
End With
Next i
' Escribir total surtido y existencia final
ws.Cells(fila, colTotalSurtido).Value = totalSurtido
ws.Cells(fila, colFinalInventario).Value = inventario
Next fila
MsgBox "Resultado surtido cargado con éxito...", vbInformation
End Sub
Para la opción 2:
Sub surtirenpartesiguales()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
Dim filaInicio As Integer: filaInicio = 13
Dim filaFin As Integer: filaFin = 16
Dim colInventario As Integer: colInventario = 2
Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C
Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I
Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L
Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M
Dim numClientes As Integer: numClientes = 3
Dim fila As Integer, i As Integer
For fila = filaInicio To filaFin
Dim inventario As Double
inventario = Val(ws.Cells(fila, colInventario).Value)
Dim solicitudes(1 To 3) As Double
Dim surtido(1 To 3) As Variant
Dim totalSurtido As Double: totalSurtido = 0
Dim totalPedido As Double: totalPedido = 0
' Leer solicitudes
For i = 1 To numClientes
If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then
solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value)
totalPedido = totalPedido + solicitudes(i)
Else
solicitudes(i) = 0
End If
surtido(i) = 0
Next i
' Si hay suficiente inventario, surtir lo que el cliente pide
If inventario >= totalPedido Then
For i = 1 To numClientes
If solicitudes(i) > 0 And inventario >= solicitudes(i) Then
surtido(i) = solicitudes(i)
inventario = inventario - solicitudes(i)
totalSurtido = totalSurtido + solicitudes(i)
End If
Next i
Else
' Reparto base igualitario
Dim baseSurtido As Long
baseSurtido = Int(inventario / numClientes)
For i = 1 To numClientes
If solicitudes(i) > 0 Then
If solicitudes(i) <= baseSurtido Then
surtido(i) = solicitudes(i)
inventario = inventario - solicitudes(i)
totalSurtido = totalSurtido + solicitudes(i)
Else
surtido(i) = baseSurtido
inventario = inventario - baseSurtido
totalSurtido = totalSurtido + baseSurtido
End If
End If
Next i
' Repartir sobrante restante uno por uno, respetando lo pedido
Do While inventario > 0
For i = 1 To numClientes
If surtido(i) < solicitudes(i) Then
surtido(i) = surtido(i) + 1
totalSurtido = totalSurtido + 1
inventario = inventario - 1
If inventario = 0 Then Exit For
End If
Next i
Loop
End If
' Escribir resultados en las columnas correspondientes para cada cliente
For i = 1 To numClientes
With ws.Cells(fila, colResultadoInicio + i - 1)
If surtido(i) = 0 Then
.Value = "POR FALTA STOCK"
.Font.Color = vbRed
Else
.Value = surtido(i)
.Font.Color = vbBlack
End If
End With
Next i
' Escribir total surtido y existencia final
ws.Cells(fila, colTotalSurtido).Value = totalSurtido
ws.Cells(fila, colFinalInventario).Value = inventario
Next fila
MsgBox "Resultado surtido cargado con éxito...", vbInformation
End Sub
Saludos,
Diego