无需VBA实现Excel动态下拉菜单 选中值自动从其余下拉移除

方案1：辅助列+公式+数据验证（无需VBA，适配全版本Excel） #

操作步骤 #

• 基础配置：假设100名员工的排名填写区域为B2:B101（表头B1填「绩效排名」），在空白列D2:D101录入完整可选排名序列（如1~100，也可根据需求替换为S/A/B/C等固定等级序列）。
• 生成可用值辅助列：在空白列E2输入公式，自动过滤掉已经被选中的排名：

  Excel 365/2021及以上版本（支持动态数组）直接输入：
  =FILTER(D2:D101,ISNA(MATCH(D2:D101,B:B,0)))
  低版本Excel需输入数组公式，按Ctrl+Shift+Enter确认后下拉填充到E101：
  =IFERROR(INDEX(D:D,SMALL(IF(COUNTIF(B:B,D$2:D$101)=0,ROW(D$2:D$101),99999),ROW(A1))),"")

• 配置下拉菜单：选中B2:B101所有需要填写排名的单元格，依次点击「数据」选项卡→「数据验证」，允许类型选「序列」，来源填写对应公式：

  365/2021及以上版本直接引用溢出区域：=E2#
  低版本用偏移函数匹配可用值长度：=OFFSET(E2,0,0,COUNTA(E:E)-1,1)
  勾选「忽略空值」「提供下拉箭头」后确认即可。

方案2：VBA事件实现（无辅助列，响应更流畅） #

适合对Excel宏操作有基础的用户，无需维护辅助列，修改后自动刷新下拉选项：

• 按Alt+F11打开VBA编辑器，在左侧工程面板双击你要设置排名的工作表，粘贴以下代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rankCount As Integer, selectRng As Range, validStr As String
    ' 可根据实际需求修改排名填写范围、排名总数量
    Set selectRng = Me.Range("B2:B101")
    rankCount = 100
    ' 仅监控排名填写区域的修改
    If Not Intersect(Target, selectRng) Is Nothing Then
        Application.EnableEvents = False
        validStr = ""
        ' 拼接未被选中的排名值
        For i = 1 To rankCount
            If Application.WorksheetFunction.CountIf(selectRng, i) = 0 Then
                validStr = validStr & i & ","
            End If
        Next
        ' 移除末尾多余逗号
        If validStr <> "" Then validStr = Left(validStr, Len(validStr) - 1)
        ' 统一更新所有单元格的下拉选项
        With selectRng.Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=validStr
            .IgnoreBlank = True
            .InCellDropdown = True
        End With
        Application.EnableEvents = True
    End If
End Sub

• 保存文件时选择.xlsm格式，打开文件时启用宏即可生效。

额外优化建议 #

• 如需避免手动输入重复值，可添加条件格式：选中B2:B101，设置条件格式公式为=COUNTIF(B:B,B2)>1，匹配时填充红色高亮，重复值一目了然。
• 若使用等级而非数字排名，只需将方案中1~100的序列替换为你的等级列表，对应修改公式/代码的遍历逻辑即可。

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