Excel VBA需求：自动更新Material Sheet表格仅显示数量>0物料

背景 #

我是电气承包商，做了一套投标用的Excel工作表，核心有三个表：

• Bid Cut Sheet：用来输入具体任务的数量，比如这次要装24个插座
• Job List：把任务拆成需要的物料和人工，物料数量是用Bid Cut Sheet里的任务数计算得出的
• Material Sheet：分Rough、Trim、Service三个阶段汇总总物料需求，对应三个结构化表格Rough_Material、Trim_Material、Service_Material，数量列通过公式从Job List汇总数据

需求 #

1. Material Sheet中的三个表格自动更新，仅保留数量>0的物料行
2. 在Bid Cut Sheet输入新任务时，自动添加对应数量>0的物料行
3. 每次输入数据后自动触发更新，无需手动操作

现有代码局限 #

目前的代码只能删除数量为0的行，但无法在新增任务时自动添加对应的物料行：

Sub DeleteRowsBasedonCellValue()
    'Declare Variables
    Dim i As Long, LastRow As Long, Row As Variant
    Dim listObj As ListObject
    Dim tblNames As Variant, tblName As Variant
    Dim colNames As Variant, colName As Variant
                    'Names of tables
    tblNames = Array("Rough_Material", "Trim_Material", "Service_Material")
    colNames = Array("Rough", "Trim", "Service")
                    
    
    'Loop Through Tables
    For i = LBound(tblNames) To UBound(tblNames)
        tblName = tblNames(i)
        colName = colNames(i)
        Set listObj = ThisWorkbook.Worksheets("MaterialSheet").ListObjects(tblName)
        'Define First and Last Rows
        LastRow = listObj.ListRows.Count
        'Loop Through Rows (Bottom to Top)
        For Row = LastRow To 1 Step -1
            With listObj.ListRows(Row)
                If Intersect(.Range, _
                listObj.ListColumns(colName).Range).Value = 0 Then
                    .Delete
                End If
            End With
        Next Row
    Next i
End Sub

解决方案 #

要实现自动增删行，需要先从Job List同步所有有效物料，再清理无效行，同时添加自动触发事件来响应数据输入。

1. 编写完整的同步更新子程序 #

这个子程序会清空现有表格的内容（保留表头），从Job List提取各阶段数量>0的物料，再写入对应表格：

Sub SyncMaterialTables()
    Dim wsJobList As Worksheet, wsMaterial As Worksheet
    Dim tblRough As ListObject, tblTrim As ListObject, tblService As ListObject
    Dim jobListData As Variant, roughData As Collection, trimData As Collection, serviceData As Collection
    Dim i As Long
    
    '初始化工作表和表格对象
    Set wsJobList = ThisWorkbook.Worksheets("Job List")
    Set wsMaterial = ThisWorkbook.Worksheets("MaterialSheet")
    Set tblRough = wsMaterial.ListObjects("Rough_Material")
    Set tblTrim = wsMaterial.ListObjects("Trim_Material")
    Set tblService = wsMaterial.ListObjects("Service_Material")
    
    '初始化存储有效物料的集合
    Set roughData = New Collection
    Set trimData = New Collection
    Set serviceData = New Collection
    
    '读取Job List数据（假设表头在第1行）
    jobListData = wsJobList.UsedRange.Value
    
    '遍历Job List，筛选各阶段数量>0的物料
    '注：请根据实际表格列调整索引，示例中A=物料名，B=Rough数量，C=Trim数量，D=Service数量
    For i = 2 To UBound(jobListData, 1) '跳过表头行
        If jobListData(i, 2) > 0 Then
            roughData.Add Array(jobListData(i, 1), jobListData(i, 2))
        End If
        If jobListData(i, 3) > 0 Then
            trimData.Add Array(jobListData(i, 1), jobListData(i, 3))
        End If
        If jobListData(i, 4) > 0 Then
            serviceData.Add Array(jobListData(i, 1), jobListData(i, 4))
        End If
    Next i
    
    '更新三个阶段的物料表
    Call UpdateTable(tblRough, roughData)
    Call UpdateTable(tblTrim, trimData)
    Call UpdateTable(tblService, serviceData)
End Sub

'辅助子程序：清空表格并写入新数据
Sub UpdateTable(targetTbl As ListObject, dataCol As Collection)
    Dim newRow As ListRow, item As Variant
    
    '清空现有数据行（保留表头）
    If targetTbl.ListRows.Count > 0 Then
        targetTbl.DataBodyRange.Delete
    End If
    
    '写入新的有效物料数据
    For Each item In dataCol
        Set newRow = targetTbl.ListRows.Add
        newRow.Range(1) = item(0) '物料名称列
        newRow.Range(2) = item(1) '数量列
        '如果表格有更多列，可继续添加对应数据
    Next item
End Sub

2. 添加自动触发事件 #

打开Bid Cut Sheet的代码窗口（右键工作表标签→查看代码），粘贴以下代码，实现输入任务数量后自动更新物料表：

Private Sub Worksheet_Change(ByVal Target As Range)
    '仅当修改的单元格在任务数量输入区域时触发（示例为A2:A100，可根据实际调整）
    If Not Intersect(Target, Me.Range("A2:A100")) Is Nothing Then
        Application.EnableEvents = False '防止循环触发事件
        Call SyncMaterialTables
        Application.EnableEvents = True
    End If
End Sub

注意事项 #

• 请根据自己表格的实际列结构，调整SyncMaterialTables中Job List的列索引
• 确保Job List的数据规范，没有多余空行干扰
• 测试前请备份Excel文件，避免数据丢失

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