如何实现Excel数据验证列自动将新值添加至指定lookup range？

数据验证本身无法直接实现「输入新值自动添加到查找范围」的功能，需要配合VBA宏来完成，以下是针对你场景的具体方案：

场景回顾 #

• 工作表application cost的Application列通过数据验证，引用Applications工作表的applications列作为下拉选项
• 需要实现：在application cost的Application列输入不在现有列表中的值时，该值自动被添加到Applications的applications列，同时更新下拉选项

步骤1：调整数据验证的错误提示设置 #

默认数据验证会阻止输入无效值，需要先修改设置允许输入：

1. 选中application cost表中Application列的所有数据验证单元格
2. 打开「数据验证」设置窗口，切换到「出错警告」选项卡
3. 将「样式」改为警告或信息（不要选「停止」），这样输入不在范围内的值时，Excel会弹出提示但允许你完成输入；也可以直接取消勾选「输入无效数据时显示出错警告」，直接允许输入

步骤2：设置动态命名范围（可选但推荐） #

为了让下拉菜单自动更新新添加的选项，给Applications表的applications列设置动态命名范围：

1. 点击「公式」选项卡 → 「定义名称」
2. 名称输入AppList，引用位置输入：

   =OFFSET(Applications!$A$1,0,0,COUNTA(Applications!$A:$A),1)
   

3. 回到application cost表的「数据验证」设置，将原引用范围替换为=AppList

步骤3：添加VBA宏代码 #

通过工作表的Change事件触发逻辑，检查输入值并自动添加到列表：

1. 右键点击application cost工作表的标签，选择「查看代码」
2. 在弹出的VBA编辑器中，粘贴以下代码：

   Private Sub Worksheet_Change(ByVal Target As Range)
       ' 定义Application列的范围，根据实际列修改（示例为A列）
       Dim appColumn As Range
       Set appColumn = Me.Range("A:A")
       
       ' 只处理单个单元格的修改，且修改的是Application列
       If Target.Cells.Count > 1 Or Intersect(Target, appColumn) Is Nothing Then Exit Sub
       
       Dim newApp As String
       newApp = Trim(Target.Value)
       
       ' 空值不处理
       If newApp = "" Then Exit Sub
       
       ' 指向Applications工作表
       Dim appSheet As Worksheet
       Set appSheet = ThisWorkbook.Worksheets("Applications")
       
       ' 指向Applications表的applications列（示例为A列）
       Dim appListRange As Range
       Set appListRange = appSheet.Range("A:A")
       
       ' 检查新值是否已存在于列表中
       Dim found As Range
       Set found = appListRange.Find(What:=newApp, LookIn:=xlValues, LookAt:=xlWhole)
       
       If found Is Nothing Then
           ' 找到applications列的最后一行，准备添加新值
           Dim lastRow As Long
           lastRow = appSheet.Cells(appSheet.Rows.Count, "A").End(xlUp).Row + 1
           
           ' 添加新应用名称到列表
           appSheet.Cells(lastRow, "A").Value = newApp
           
           ' 可选：给新应用添加默认描述（比如空值或自定义文本），取消下面注释即可
           ' appSheet.Cells(lastRow, "B").Value = ""
       End If
   End Sub
   

3. 修改代码中的列范围：如果你的Application列不是A列，或者Applications表的applications列不是A列，替换代码中对应的Range参数

注意事项 #

• 保存文件为.xlsm格式（启用宏的工作簿），否则宏无法生效；打开文件时需启用宏
• 若未设置动态命名范围，添加新值后需要手动刷新数据验证的引用范围，才能在下拉菜单中看到新选项

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