如何在 Excel 2016 中使用 VBA 创建依赖下拉列表？

Question

我想在以下工作表（计划）的 B 列中创建一个下拉列表：

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

数据包含在以下工作表（Data）中：

为了使事情复杂化，我希望下拉菜单根据 Planning.$D3 中选择的语言显示数据工作表中的内容（如果选择英语，则显示绿色文本，如果选择日语，则显示红色文本）。只有具有 Dimension 和 Label == "index" 的行应该出现在下拉列表中（2、8、15，...）。选择后，下拉菜单应显示零件数据（蓝色）。

如何在 VBA 中构建这样的下拉菜单？

Answer 1

这是一个有趣的问题，当在 A 列中输入维度代码时，我使用在 B 列中的单元格上设置验证的方法得到了下面的代码。

一旦选择了一个选项，B 列中文本的颜色就会变为蓝色，但您想要的绿色和红色文本实际上是不可能的，因为在单元格下拉列表中，无论单元格的字体颜色如何，始终显示黑色.

代码并不完美，但更多的是概念证明，可以让您抢占先机。

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