且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

如何在Excel 2016中使用VBA创建复杂的从属下拉列表?

更新时间:2023-02-01 09:31:44

我不确定在将其发布为时是否尝试过此操作

I'm not sure if you tried this when I posted it as an answer on your question from yesterday.

该代码通过选择时根据A列中的值即时创建一个验证下拉列表,来完成您所需的一切B列中的单元格。下拉菜单根据语言显示产品代码和说明。一旦选择了产品代码,就删除了描述,并从单元格中删除了验证。

The code does everything that you need by creating a validation dropdown on-the-fly based on the value in column A when you select a cell on column B. The dropdown displays the product code and the description depending on the language. The description is removed once a product code has been selected and the validation is removed from the cell.

虽然代码可以完成您所需的所有操作,但它并不完美,但是可以为您提供一个巨大的开端,并且可以与您的工作表名称一起使用,如果您复制粘贴,

While the code does do everything that you require it's not perfect but it gives you a huge head start and it should work with your sheet names etc. if you copy and paste it and give it a try.

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