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

我想要在下面的工作表(规划)的B列中创build一个下拉列表:

计划工作表

D3单元格包含要显示的语言。 当在列A中input一个维度时,我想要一个由input的维度过滤的部分的下拉列表。

数据包含在以下工作表(数据)中:

数据工作表

为了使事情复杂化,我希望下拉菜单根据规划中选定的语言来显示数据工作表中的内容。$ D3(如果select英语显示绿色文本,如果select日语显示红色文本)。 只有具有维度和标签==“索引”的行应出现在下拉列表(2,8,15,…)中。 一旦选定,下拉菜单应显示零件数据(蓝色)。

我如何在VBA中创build这样的下拉菜单?

这是一个有趣的问题,我得到了下面的代码工作使用列B中的单元格中设置validation的方法时,在A列中input维度代码。

B列中的文本颜色一旦select了一个选项就会变成蓝色,但是您想要的绿色和红色文本并不是真的可能,因为在单元格下拉列表中总是显示黑色,而不pipe单元格的字体颜色如何。

代码不是完美的,但更多的只是一个概念的certificate,给你一个很大的开端。

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 300 If Sheets("Data").Cells(intRow, 1) = Target.Offset(0, -1) Then If Sheets(Target.Parent.Name).Cells(3, 4) = "English" Then strValidList = strValidList & Sheets("Data").Cells(intRow, 2) & " ~ " & Sheets("Data").Cells(intRow, 3) & ", " Else strValidList = strValidList & Sheets("Data").Cells(intRow, 2) & " ~ " & Sheets("Data").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