Excel项目成本表：自动生成动态数据验证下拉列表需求问询

我有一张用于计算项目成本的Excel工作表，成本分为9个主组，每个主组下分9个组，每个组又分9个子组。当子组（如SUBGROUP 002）项包含多个部件（例如门包含木材、门把手、钉子等）时，我会将供应商提供的若干报价插入到该子组项下方。由于该工作表有3000多行，我想实现：在子组项的成本单元格中，当下方添加报价时自动生成下拉列表，且后续添加新报价时列表能自动更新。

我曾尝试编写宏来生成新行和下拉列表，但无法实现与生成单元格无关的通用功能，现有宏代码如下：

Private Sub CommandButton1_Click()

Sheets("Sheet2").Range("A6").Select
ActiveCell.EntireRow.Insert Shift:=xlDown

Sheets("Sheet2").Range("D5").Select
With Selection.Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, _
Formula1:="=Sheet2!$D$6:$D$9"
.IgnoreBlank = True
.InCellDropdown = True
End With

End Sub

要实现通用的自动更新下拉列表，核心是用动态命名区域配合宏，让下拉列表的数据源能自动扩展，同时宏要能识别当前选中的子组行，自动插入报价行并关联动态区域。

步骤1：创建动态命名区域 #

• 打开Excel的「公式」选项卡，点击「定义名称」
• 名称设为SubgroupQuotes，引用位置输入：

  =OFFSET(Sheet2!$D$1,1,0,COUNTA(Sheet2!$D:$D)-1,1)
  

  （注：这里假设报价都在D列，从第2行开始；如果你的报价列不是D，自行调整列标）
• 点击确定，这个区域会自动包含D列所有非空单元格，新增报价时自动扩展。

步骤2：修改宏代码实现通用功能 #

替换原有宏代码为以下内容，它会自动识别当前选中的子组行，在下方插入新报价行，并给子组的成本单元格设置关联动态区域的下拉列表：

Private Sub CommandButton1_Click()
    Dim currentRow As Integer
    Dim subgroupCostCell As Range
    
    ' 获取当前选中行（假设选中的是子组行的任意单元格）
    currentRow = ActiveCell.Row
    
    ' 在当前行下方插入新行（用于添加报价）
    Rows(currentRow + 1).Insert Shift:=xlDown
    
    ' 定位子组的成本单元格（假设成本在D列，子组行的D列就是要加下拉的单元格）
    Set subgroupCostCell = Sheets("Sheet2").Cells(currentRow, "D")
    
    ' 清除原有验证规则（避免重复添加）
    subgroupCostCell.Validation.Delete
    
    ' 添加关联动态命名区域的下拉列表
    With subgroupCostCell.Validation
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, _
        Formula1:="=SubgroupQuotes"
        .IgnoreBlank = True
        .InCellDropdown = True
    End With
End Sub

补充说明 #

• 如果你的子组成本列不是D列，修改代码中Cells(currentRow, "D")的列标即可
• 动态命名区域会自动包含所有新增的报价行，不需要手动调整下拉列表的数据源范围
• 确保每次操作前选中对应的子组行，宏会自动识别并处理

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