选择一个少一个，这样的下拉菜单才够拽

一般的下拉菜单，无论什么时候，下拉选项都是一样的，这样不仅不便于选择，而且一不留神就容易重复录入数据。

如果能选择一个，下拉菜单中就少一个，这样岂不是方便的很嘛。咱们来看看效果：

接下来就看看具体的实现步骤：

首先在Sheet2工作表中输入候选的人员名单：

按Alt+F11组合键，调出VBE操作界面，单击左侧工程窗口的工作表名称Sheet1，在右侧的代码窗口中输入代码。

以下是完整的代码和注释，只要把这些内容全部复制，粘贴到代码窗口中，就可以使用了：

Private Sub ComboBox1_Change() '组合框的值发生改变时

Selection = ComboBox1.Value'当组合框的值发生改变时，

'就将组合框的值赋给选择的单元格(选择区域)

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim hang% '整型，用于接收最后的行号

Dim arr() '定义数组

Dim k'变体型

Dim aa '变体型

On Error Resume Next'发生错误时继续运行，【必须】

If Target.Row= 2Then '【Target为选择的单元格】，

'当选择单元格的行号为2时条件成立

'以下让组合框的长宽、顶部底部等于选择单元格，实现随单元格移动

With ComboBox1

.Top = Target.Top

.Left = Target.Left

.Width = Target.Width

.Height = Target.Height

.Visible = True

End With

'返回sheet2表中A列最后一行的行号

hang = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row

arr = Sheet2.Range("A1:A" & hang) '指定区域的人名 赋值数组arr

arr = WorksheetFunction.Transpose(arr) '调用工作表函数，二维数组转一维

ComboBox1.Clear'先清除组合框的所有数据【重要】，否则会累计增加数据

'以下for each 循环

For Each aa In arr

k = Sheet1.Range("A2:H2").Find(aa) '在指定区域查找循环除的人名

If k = "" Then

ComboBox1.AddItem aa'只有当k为空时，则添加一个名字到组合框

End If

Next

Else

ComboBox1.Visible = False'当选择单元格的行不为2时，隐藏组合框

End If

End Sub

粘贴完成后关闭VBE界面，就可以使用动态的下拉菜单了。

小伙伴们在使用时，可以根据需要更改代码中红色部分的条件和范围范围，你也试试。

注意注意：文件保存的时候需选择 excel 启用宏的工作簿(*.xlsm)，不然代码会丢失的！

图文制作：赵中山

专业的职场技能充电站