跨工作薄设置excel下拉菜单

excel设置下拉菜单时，我们都知道可以跨工作表选择数据设置菜单。那能否跨工作薄设置菜单呢？答案是可以的，而且还可以在不打开数据源文件的情况下设置，今天就给大家分享一下如何跨工作薄设置下拉菜单。

下图数据源文件“数据源.xlsx”里有基础数据，要在另外一个文件“跨文件设置联动下拉菜单.xlsm”里设置下拉菜单，使用“数据源.xlsx”文件里的数据作为菜单下拉选项。

跨表单设置菜单时，定义名称时有个范围，最多只能在当本工作薄内引用，不能跨工作薄。如下图：

我们用VBA解决跨文件设置菜单，具体方法为：

将要设置菜单文件和数据源文件都打开，在设置菜单文件里打开VBA编辑界面，双击要设置下拉菜单的表单名称，在右侧代码区粘贴下面的代码，跨文件的一二级菜单就生成完成了。

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim arr On Error Resume Next Set cdb = ActiveSheet Set d = CreateObject("Scripting.Dictionary") Set wb = Workbooks("数据源.xlsx") arr = wb.Sheets("Sheet1").UsedRange If Target.Count = 1 And Target.Row > 2 And Target.Column = 1 Then For i = 2 To UBound(arr) If arr(i, 1) <> "" Then d(arr(i, 1)) = "" Next s = Join(d.keys, ",") With Target.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=s End With Set s = Nothing End If If Target.Count = 1 And Target.Row > 2 And Target.Column = 2 Then sjcd = cdb.Cells(Target.Row, Target.Column - 1) If sjcd <> "" Then For i = 2 To UBound(arr) If arr(i, 1) = sjcd Then For j = 2 To UBound(arr, 2) If arr(i, j) <> "" Then d(arr(i, j)) = "" Next End If Next s = Join(d.keys, ",") With Target.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=s End With Set s = Nothing End If End If End Sub

演示效果如下：