Excel VBA发货处理宏故障：无法定位右侧首个有效订单单元格

我正在开发公司的发货管理Excel文件，预期流程：

• 用户点击按钮调出用户窗体（Userform）
• 用户填写零件编码和发货数量，点击确认按钮
• 宏在零件编码列（C6:C42）查找对应编码以获取行号
• 向右定位该行首个有效订单（未被清空的订单数据）
• 从订单中扣除发货数量，订单完成（数量减为0）则清空该订单的数量、日期、采购单号，继续处理下一个订单直到发货数量全部扣完

目前代码无报错但无法正常运行，核心问题是无法找到右侧最近的有效数据单元格进行计算。

原代码 #

Private Sub CommandButton1_Click()

Dim cell As Variant


'TEXTBOX1 IS WHERE YOU INPUT THE CODE TO CHECK FOR IN COLUMN C

Set cell = Sheets("TEST").Range("C6:C42").Find(What:=TextBox1, LookIn:=xlFormulas, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=True, SearchFormat:=False)

If Not cell Is Nothing Then

Line1:  'USED FOR LOOPING IF VALUE IS SMALLER THEN TEXTBOX2 (IN TEXTBOX2 YOU INSERT THE QUANTITY SHIPPED)

' GET CLOSEST VALUE TO THE RIGHT BUT DOESNT WORK

    If Range(cell.Address).End(xlToRight).Value2 >= TextBox2 Then
        Range(cell.Address).End(xlToRight).Value2 = Range(cell.Address).End(xlToRight).Value2 - TextBox2
        
' IF THERE ARE NO MORE PARTS IN THAT ORDER THEN ELIMINATE IT (ELIMINATES QUANTITY,DATE AND PURCHASE ORDER)

    If Range(cell.Address).End(xlToRight).Value2 = 0 Then
    Range(Range(cell.Address).End(xlToRight), Range(cell.Address).End(xlToRight).Offset(0, 2)).ClearContents
    End If
        
'IF I SHIP MORE PARTS THAN WHAT THE ORDER RQUIRES CANCEL THAT ORDER AND MOVE TO NEXT ONE

    ElseIf Range(cell.Address).End(xlToRight).Value2 < TextBox2 Then
    
        TextBox2 = TextBox2 - Range(cell.Address).End(xlToRight).Value2
        
        Range(Range(cell.Address).End(xlToRight), Range(cell.Address).End(xlToRight).Offset(0, 2)).ClearContents
    
    GoTo Line1 'FOR LOOPING
    
    End If
End Sub

Excel表格截图 #

问题根源 #

1. Range(cell.Address).End(xlToRight)会直接跳到该行最右侧的非空单元格，而非从当前单元格右侧开始查找第一个有效订单，中间有空订单列时会直接跳过，无法按顺序处理
2. 缺少循环终止条件，所有订单处理完后仍会陷入死循环
3. 未对输入的发货数量做有效性校验，存在非数字输入的风险
4. GoTo语句导致代码逻辑混乱，不易维护

修正后的代码 #

Private Sub CommandButton1_Click()
    Dim partCell As Range
    Dim orderQtyCell As Range
    Dim remainingShipQty As Double
    Dim ws As Worksheet
    
    ' 校验发货数量输入有效性
    If Not IsNumeric(TextBox2.Value) Or CDbl(TextBox2.Value) <= 0 Then
        MsgBox "请输入大于0的有效数字作为发货数量", vbExclamation
        Exit Sub
    End If
    remainingShipQty = CDbl(TextBox2.Value)
    
    Set ws = Sheets("TEST")
    ' 查找零件编码对应的行（按值查找，更准确）
    Set partCell = ws.Range("C6:C42").Find(What:=TextBox1.Value, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True)
    
    If partCell Is Nothing Then
        MsgBox "未找到零件编码：" & TextBox1.Value, vbExclamation
        Exit Sub
    End If
    
    ' 循环处理订单，直到发货数量耗尽或无有效订单
    Do While remainingShipQty > 0
        ' 从零件编码右侧第一列（D列）开始，查找第一个有效订单的数量单元格
        Set orderQtyCell = partCell.Offset(0, 1)
        Do While orderQtyCell.Column <= ws.UsedRange.Columns.Count
            ' 判断当前单元格是否为有效订单数量（有数值且大于0）
            If IsNumeric(orderQtyCell.Value) And orderQtyCell.Value > 0 Then
                Exit Do
            End If
            ' 移动到下一个订单的数量列（每个订单占3列：数量、日期、采购单，所以+3）
            Set orderQtyCell = orderQtyCell.Offset(0, 3)
        Loop
        
        ' 未找到有效订单，终止循环并提示剩余数量
        If orderQtyCell.Column > ws.UsedRange.Columns.Count Then
            MsgBox "零件【" & TextBox1.Value & "】的所有订单已处理完毕，剩余未发货数量：" & remainingShipQty, vbInformation
            Exit Do
        End If
        
        ' 处理当前订单
        If orderQtyCell.Value >= remainingShipQty Then
            ' 订单数量足够，扣除发货数量
            orderQtyCell.Value = orderQtyCell.Value - remainingShipQty
            ' 订单数量为0时，清空整个订单的3列数据
            If orderQtyCell.Value = 0 Then
                orderQtyCell.Resize(1, 3).ClearContents
            End If
            remainingShipQty = 0 ' 发货数量耗尽，结束循环
        Else
            ' 订单数量不足，扣除全部订单数量，继续处理下一个
            remainingShipQty = remainingShipQty - orderQtyCell.Value
            orderQtyCell.Resize(1, 3).ClearContents
        End If
    Loop
    
    MsgBox "发货处理完成！", vbInformation
End Sub

关键改进 #

• 替换End(xlToRight)为逐列查找逻辑，确保从左到右处理第一个有效订单
• 增加输入有效性校验，避免无效输入报错
• 用Do While循环替代GoTo，逻辑更清晰，避免死循环
• 明确订单列结构（每3列为一个订单单元），通过Offset(0,3)精准定位下一个订单
• 增加循环终止条件，无有效订单时提示剩余未发货数量

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