基于FIFO规则的Excel VBA拣货清单生成：数量无法完全提取问题

相关工作表截图 #

• Orders工作表：
• PickList工作表：
• Live Stock工作表：

VBA代码 #

Sub CreatePickListWithoutEditingStock()

    Dim wsOrders As Worksheet
    Dim wsLiveStock As Worksheet
    Dim wsPickList As Worksheet
    Dim orderRow As Long
    Dim stockRow As Long
    Dim pickRow As Long
    Dim qtyToPick As Long
    Dim qtyPicked As Long
    Dim pickListNumber As Long
    Dim lastOrderRow As Long
    Dim lastStockRow As Long
    Dim stockQty As Long
    Dim dateOrdered As Date
    Dim orderNumber As String
    Dim itemCode As String
    Dim itemName As String
    
    ' 定义工作表
    Set wsOrders = ThisWorkbook.Sheets("Orders")
    Set wsLiveStock = ThisWorkbook.Sheets("Live Stock")
    Set wsPickList = ThisWorkbook.Sheets("PickList")
    
    ' 获取Orders表最后一行
    lastOrderRow = wsOrders.Cells(wsOrders.Rows.Count, 1).End(xlUp).Row
    
    ' 初始化拣货清单编号
    pickListNumber = 1
    
    ' 遍历每笔订单
    For orderRow = 2 To lastOrderRow
        dateOrdered = wsOrders.Cells(orderRow, 1).Value
        orderNumber = wsOrders.Cells(orderRow, 2).Value
        itemCode = wsOrders.Cells(orderRow, 3).Value
        itemName = wsOrders.Cells(orderRow, 4).Value
        qtyToPick = wsOrders.Cells(orderRow, 5).Value
        
        ' 获取Live Stock表最后一行
        lastStockRow = wsLiveStock.Cells(wsLiveStock.Rows.Count, 1).End(xlUp).Row
        
        ' 按FIFO规则从Live Stock中拣货（不更新库存数量）
        For stockRow = 2 To lastStockRow
            If wsLiveStock.Cells(stockRow, 1).Value = itemCode Then
                stockQty = wsLiveStock.Cells(stockRow, 5).Value
                If stockQty > 0 Then
                    If qtyToPick <= stockQty Then
                        qtyPicked = qtyToPick
                    Else
                        qtyPicked = stockQty
                    End If
                    
                    ' 在PickList中添加记录
                    pickRow = wsPickList.Cells(wsPickList.Rows.Count, 1).End(xlUp).Row + 1
                    wsPickList.Cells(pickRow, 1).Value = dateOrdered
                    wsPickList.Cells(pickRow, 2).Value = pickListNumber
                    wsPickList.Cells(pickRow, 3).Value = itemCode
                    wsPickList.Cells(pickRow, 4).Value = itemName
                    wsPickList.Cells(pickRow, 5).Value = wsLiveStock.Cells(stockRow, 3).Value ' 最佳过期日期
                    wsPickList.Cells(pickRow, 6).Value = wsLiveStock.Cells(stockRow, 4).Value ' 存储位置
                    wsPickList.Cells(pickRow, 7).Value = qtyPicked
                    wsPickList.Cells(pickRow, 8).Value = wsLiveStock.Cells(stockRow, 6).Value ' 剩余保质期
                    
                    qtyToPick = qtyToPick - qtyPicked
                    If qtyToPick <= 0 Then Exit For
                End If
            End If
        Next stockRow
        
        ' 如果仍有未满足的数量，弹出提示
        If qtyToPick > 0 Then
            MsgBox "订单编号 " & orderNumber & " 中的商品编码 " & itemCode & " 无法满足所需数量。", vbExclamation
        End If

        ' 递增拣货清单编号
        pickListNumber = pickListNumber + 1
    Next orderRow
    
    MsgBox "拣货清单已成功生成！", vbInformation
End Sub

技术问题 #

使用上述基于FIFO（先进先出）规则的Excel VBA代码生成拣货清单（PickList）时，遇到拣货清单的数量无法完全提取的问题，需要排查并解决该异常。

问题排查与修复方案 #

核心问题分析 #

1. FIFO逻辑失效：当前代码按Live Stock表的原始行顺序遍历，若库存未按**最佳过期日期（FIFO核心依据）**排序，会优先拣取晚到期的批次，甚至遗漏早到期的同编码库存，导致无法凑齐所需数量。
2. 数据类型未校验：若Orders或Live Stock表中的数量单元格为文本格式，会引发数值计算错误，无法正确判断库存是否充足。
3. 循环逻辑遗漏：当单份订单需要从多批次库存拣货时，原代码的匹配逻辑可能因批次顺序问题，无法持续提取剩余所需数量。

修复后的代码 #

Sub CreatePickListWithoutEditingStock()

    Dim wsOrders As Worksheet
    Dim wsLiveStock As Worksheet
    Dim wsPickList As Worksheet
    Dim orderRow As Long
    Dim stockRow As Long
    Dim pickRow As Long
    Dim qtyToPick As Long
    Dim qtyPicked As Long
    Dim pickListNumber As Long
    Dim lastOrderRow As Long
    Dim lastStockRow As Long
    Dim stockQty As Long
    Dim dateOrdered As Date
    Dim orderNumber As String
    Dim itemCode As String
    Dim itemName As String
    
    ' 定义工作表
    Set wsOrders = ThisWorkbook.Sheets("Orders")
    Set wsLiveStock = ThisWorkbook.Sheets("Live Stock")
    Set wsPickList = ThisWorkbook.Sheets("PickList")
    
    ' 获取Orders表最后一行
    lastOrderRow = wsOrders.Cells(wsOrders.Rows.Count, 1).End(xlUp).Row
    
    ' 初始化拣货清单编号
    pickListNumber = 1
    
    ' 遍历每笔订单
    For orderRow = 2 To lastOrderRow
        dateOrdered = wsOrders.Cells(orderRow, 1).Value
        orderNumber = wsOrders.Cells(orderRow, 2).Value
        itemCode = wsOrders.Cells(orderRow, 3).Value
        itemName = wsOrders.Cells(orderRow, 4).Value
        
        ' 校验订单数量格式，转换为数值类型
        If IsNumeric(wsOrders.Cells(orderRow, 5).Value) Then
            qtyToPick = CLng(wsOrders.Cells(orderRow, 5).Value)
        Else
            MsgBox "订单编号 " & orderNumber & " 数量格式错误，请检查。", vbCritical
            GoTo NextOrder
        End If
        
        ' 获取Live Stock表最后一行
        lastStockRow = wsLiveStock.Cells(wsLiveStock.Rows.Count, 1).End(xlUp).Row
        
        ' 按FIFO规则排序库存：先最佳过期日期升序，再商品编码升序
        wsLiveStock.Range("A1:F" & lastStockRow).Sort _
            Key1:=wsLiveStock.Range("C2:C" & lastStockRow), Order1:=xlAscending, _
            Key2:=wsLiveStock.Range("A2:A" & lastStockRow), Order2:=xlAscending, _
            Header:=xlYes
        
        ' 遍历排序后的库存批次拣货
        For stockRow = 2 To lastStockRow
            If wsLiveStock.Cells(stockRow, 1).Value = itemCode Then
                ' 校验库存数量格式，转换为数值类型
                If IsNumeric(wsLiveStock.Cells(stockRow, 5).Value) Then
                    stockQty = CLng(wsLiveStock.Cells(stockRow, 5).Value)
                Else
                    MsgBox "商品编码 " & itemCode & " 库存数量格式错误，请检查Live Stock表。", vbCritical
                    GoTo NextOrder
                End If
                
                If stockQty > 0 Then
                    qtyPicked = IIf(qtyToPick <= stockQty, qtyToPick, stockQty)
                    
                    ' 写入PickList记录
                    pickRow = wsPickList.Cells(wsPickList.Rows.Count, 1).End(xlUp).Row + 1
                    wsPickList.Cells(pickRow, 1).Value = dateOrdered
                    wsPickList.Cells(pickRow, 2).Value = pickListNumber
                    wsPickList.Cells(pickRow, 3).Value = itemCode
                    wsPickList.Cells(pickRow, 4).Value = itemName
                    wsPickList.Cells(pickRow, 5).Value = wsLiveStock.Cells(stockRow, 3).Value ' 最佳过期日期
                    wsPickList.Cells(pickRow, 6).Value = wsLiveStock.Cells(stockRow, 4).Value ' 存储位置
                    wsPickList.Cells(pickRow, 7).Value = qtyPicked
                    wsPickList.Cells(pickRow, 8).Value = wsLiveStock.Cells(stockRow, 6).Value ' 剩余保质期
                    
                    qtyToPick = qtyToPick - qtyPicked
                    If qtyToPick <= 0 Then Exit For
                End If
            End If
        Next stockRow
        
        ' 库存不足提示，显示剩余缺口
        If qtyToPick > 0 Then
            MsgBox "订单编号 " & orderNumber & " 商品编码 " & itemCode & " 无法满足需求，剩余未拣数量：" & qtyToPick, vbExclamation
        End If

NextOrder:
        ' 递增拣货清单编号
        pickListNumber = pickListNumber + 1
    Next orderRow
    
    MsgBox "拣货清单已成功生成！", vbInformation
End Sub

修复说明 #

1. 强制FIFO排序：遍历库存前，对Live Stock表按最佳过期日期升序排序，确保优先拣取最早到期的批次，严格遵循FIFO规则。
2. 数据类型校验：添加数量单元格的数值校验与转换，避免文本格式导致的计算错误。
3. 错误跳转处理：遇到格式错误时直接跳转到下一笔订单，避免程序中断。
4. 优化提示信息：库存不足时显示具体剩余缺口，便于快速定位问题。

内容的提问来源于stack exchange，提问作者Ashok Kumar