如何在Excel 2016中使用VBA创build复杂的相关下拉菜单？

我在一个名为零件的工作表中有以下数据。

在另一个名为Planning的工作表中，我有以下数据：

在上面的Planning Worksheet中，Cell D3是一个允许select显示语言的下拉菜单。 目前的select是“英文”和“日文”。 A列的单元格也是下拉列表，允许select一个维度。

我想要做的是创build一个下拉菜单：

1. 依赖于A列中的单元格。 下拉菜单应根据相应的A单元的值过滤来自零件工作表的数据。
2. 也依赖于D3 Cell。 如果D3是“日语”，如果D3是“英语”或“日语说明”，则下拉菜单应显示 “英文说明”
3. 一旦select，下拉菜单中的数据应该是部分而不是描述 。 换句话说，它应该像HTML中的select标签一样。

我是VBA的新手，经过相当多的search，我无法弄清楚如何做到这一点。 我真的很感激一个详细的答案。 先谢谢你！

编辑：

最终的零件工作表将至less有10,000行。 用户不能手动创build指定列表。 为此，我想我应该使用VBA。

Answer 1

我不知道你是否试过这个，当我把它作为你昨天的问题的答案。

该代码通过创build基于列A中的值在运行时创buildvalidation下拉列表来完成所需的任何操作。在列B上select单元格时，下拉列表显示产品代码和说明，具体取决于语言。 一旦select了产品代码并从单元中删除了validation，该描述就会被删除。

虽然代码确实做了所有你需要的东西，但它不是完美的，但它给了你一个巨大的开端，它应该与你的工作表名称等工作，如果你复制并粘贴它，并尝试一下。

Dim CHANGING_VAL As Boolean 'Global Variable that can be set to prevent the onchange being fired when the Macro is removing the description from the dropdown. Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Column = 2 And CHANGING_VAL = False Then CHANGING_VAL = True If InStr(1, Target.Value, "~") > 2 Then Target.Value = Left(Target.Value, InStr(1, Target.Value, "~") - 2) End If Target.Validation.Delete Target.Font.Color = RGB(0, 0, 255) CHANGING_VAL = False End If End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Target.Column = 2 Then If Target.Offset(0, -1) <> "" Then strValidList = "" For intRow = 1 To 10000 If Sheets("Parts").Cells(intRow, 1) = Target.Offset(0, -1) Then If Sheets(Target.Parent.Name).Cells(3, 4) = "English" Then strValidList = strValidList & Sheets("Parts").Cells(intRow, 2) & " ~ " & Sheets("Parts").Cells(intRow, 3) & ", " Else strValidList = strValidList & Sheets("Parts").Cells(intRow, 2) & " ~ " & Sheets("Parts").Cells(intRow, 4) & ", " End If End If Next If strValidList <> "" Then strValidList = Left(strValidList, Len(strValidList) - 2) Target.Select With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=strValidList .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With End If End If Else Sheets(Target.Parent.Name).Range("B:B").Validation.Delete End If End Sub