VBA实现投标明细表输入后自动更新物料表非零需求行

背景与需求 #

我是电气承包商，制作了新房布线项目投标用的Excel工作表，核心流程如下：

• 在「Bid Cut Sheet」（投标明细表）输入任务数量（例：24个插座）；
• 「Job List」工作表自动将任务拆解为对应物料，再乘以「Bid Cut Sheet」中的任务数量；
• 「Material Sheet」工作表汇总三个阶段的物料，对应三个结构化表格：Rough_Material、Trim_Material、Service_Material。

需求：每次在「Bid Cut Sheet」输入或修改数据时，自动完成以下操作：

• 删除三个物料表中数量为0的行；
• 自动添加并填充数量>0的物料行，实现物料表动态更新。

现有问题：手头的VBA代码仅能一次性删除0值行，后续修改「Bid Cut Sheet」数据时无法自动触发更新，必须手动运行代码。

修改后的完整VBA代码 #

1. 通用处理子过程（放在标准模块中） #

Sub UpdateMaterialTables()
    '声明变量
    Dim i As Long, lastRow As Long, rowNum As Variant
    Dim listObj As ListObject
    Dim tblNames As Variant, tblName As Variant
    Dim colNames As Variant, colName As Variant
    Dim jobListWs As Worksheet
    Dim materialSheetWs As Worksheet
    
    '初始化工作表对象
    Set jobListWs = ThisWorkbook.Worksheets("Job List")
    Set materialSheetWs = ThisWorkbook.Worksheets("MaterialSheet")
    
    '三个物料表名称与对应数量列名称
    tblNames = Array("Rough_Material", "Trim_Material", "Service_Material")
    colNames = Array("Rough", "Trim", "Service")
    
    '清空所有物料表的现有数据行（保留表头）
    For i = LBound(tblNames) To UBound(tblNames)
        tblName = tblNames(i)
        Set listObj = materialSheetWs.ListObjects(tblName)
        Do While listObj.ListRows.Count > 0
            listObj.ListRows(1).Delete
        Loop
    Next i
    
    '从Job List同步物料并计算实际用量
    '假设Job List：A列=物料名称，B列=Rough单位用量，C列=Trim单位用量，D列=Service单位用量
    lastRow = jobListWs.Cells(jobListWs.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow '跳过表头行
        Dim roughQty As Double, trimQty As Double, serviceQty As Double
        '替换为「Bid Cut Sheet」中任务数量的实际单元格地址，例："$B$2"
        roughQty = jobListWs.Cells(i, "B").Value * ThisWorkbook.Worksheets("Bid Cut Sheet").Range("$B$2").Value
        trimQty = jobListWs.Cells(i, "C").Value * ThisWorkbook.Worksheets("Bid Cut Sheet").Range("$B$2").Value
        serviceQty = jobListWs.Cells(i, "D").Value * ThisWorkbook.Worksheets("Bid Cut Sheet").Range("$B$2").Value
        
        '将数量>0的物料添加到对应表格
        If roughQty > 0 Then
            Set listObj = materialSheetWs.ListObjects("Rough_Material")
            With listObj.ListRows.Add
                .Range(1).Value = jobListWs.Cells(i, "A").Value '物料名称列
                .Range(2).Value = roughQty 'Rough数量列，按需调整列索引
            End With
        End If
        
        If trimQty > 0 Then
            Set listObj = materialSheetWs.ListObjects("Trim_Material")
            With listObj.ListRows.Add
                .Range(1).Value = jobListWs.Cells(i, "A").Value
                .Range(2).Value = trimQty
            End With
        End If
        
        If serviceQty > 0 Then
            Set listObj = materialSheetWs.ListObjects("Service_Material")
            With listObj.ListRows.Add
                .Range(1).Value = jobListWs.Cells(i, "A").Value
                .Range(2).Value = serviceQty
            End With
        End If
    Next i
End Sub

2. 自动触发事件（放在「Bid Cut Sheet」的工作表模块中） #

1. 右键点击「Bid Cut Sheet」工作表标签，选择「查看代码」；
2. 在弹出的VBE窗口中粘贴以下代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    '限定触发范围为任务数量输入区域，替换为实际范围，例："$B$2:$B$10"
    If Not Intersect(Target, Me.Range("$B$2:$B$10")) Is Nothing Then
        '禁用事件避免循环触发
        Application.EnableEvents = False
        '调用物料表更新过程
        UpdateMaterialTables
        '重新启用事件
        Application.EnableEvents = True
    End If
End Sub

代码说明 #

1. 通用处理过程：

   • 先清空物料表的旧数据行，确保每次更新都是全新结果；
   • 从「Job List」读取单位用量，结合「Bid Cut Sheet」的任务数量计算实际需求；
   • 仅添加数量>0的物料，直接避免0值行出现。

2. 自动触发事件：

   • 仅当指定的任务数量输入区域发生变化时触发更新；
   • 加入Application.EnableEvents = False防止循环触发事件。

3. 注意事项：

   • 根据实际工作表结构，替换代码中标记的单元格地址和列索引；
   • 确保「Job List」的列布局与代码假设一致，若有调整需同步修改代码。

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