有谁知道如何根据另一个多选下拉菜单在 excel 中创建多选下拉菜单？

Question

我希望有人可以帮助我（我的周转时间非常紧迫（48 小时）。我在 excel 的一个列中有一个多选下拉菜单。用户可以选择和取消选择值从 12 个值的列表中（他们通常一次选择不超过 2 个）。然后我想要的是基于在该列中选择的值，它在第二列中填充另一个多选下拉列表。

例如（不是真实的例子，但我不能在真实的例子中分享价值观）：

A 列：水果、蔬菜、肉类、乳制品 （他们可以选择以上任何一项，并在单元格中存储为 (Fruit, Vegetables)。他们可以回来说他们想取消选择 Fruit 并添加 Meat，然后将其存储为 (Vegetables, Meat)。

B 列：水果选项为 (F1, F2, F3) 蔬菜 (V1, V2, V3) 肉类 (M1, M2, M3) 和乳制品 (D1, D2, D3) 等。

仅当个人为 A 列选择一个选项时，数据验证才有效。我想要工作的是它识别出 A 列中有 2 个或更多值，然后在 B 列的下拉列表中显示相应的值用户选择这也是多选并且还允许编辑。

我为什么要这样做？我需要创建一个仪表板来显示选择 A 列中的值的次数和选择 B 列中的值的次数，以及未选择哪些值，将它们全部放在一个列中我认为比拥有更容易如果适用，用户在其中输入“x”的每个值都有一个单独的列。

我愿意接受更好的方法来做到这一点。

任何帮助将不胜感激。

谢谢！

我的代码到目前为止：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strVal As String
Dim i As Long
Dim lCount As Long
Dim Ar As Variant
On Error Resume Next
Dim lType As Long
If Target.Count > 1 Then GoTo exitHandler
lType = Target.Validation.Type
If lType = 3 Then
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 7 Or Target.Column = 8 Or Target.Column = 12 Or         Target.Column = 13 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
On Error Resume Next
Ar = Split(oldVal, ", ")
strVal = ""
For i = LBound(Ar) To UBound(Ar)
Debug.Print strVal
Debug.Print CStr(Ar(i))
If newVal = CStr(Ar(i)) Then
'do not include this item
strVal = strVal
lCount = 1
Else
strVal = strVal & CStr(Ar(i)) & ", "
End If
Next i
If lCount > 0 Then
Target.Value = Left(strVal, Len(strVal) - 2)
Else
Target.Value = strVal & newVal
End If
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub

Answer 1

因此它涉及一些繁重的编码，但您可以根据其他单元格值在特定单元格中设置验证，如下所示（它们目前是硬编码的）

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Call FillCombo(Target)
End Sub

Private Function FillCombo(ByVal Target As Range)
    On Error GoTo ExitFunction
    If Target.Cells.Count > 1 Then Exit Function

    Dim ComboList As String, CLUpdate As Boolean: CLUpdate = False
    Dim CLAll As String: CLAll = "Apples,Pears,Oranges"
    Dim CLApp As String: CLApp = "Granny Smith,Pink Lady"
    Dim CLPea As String: CLPea = "Bartlett,Comice"
    Dim CLOra As String: CLOra = "Satsuma,Tangerine,Blood"

    If WorksheetFunction.CountIf(Range("A2:A4"), "Apples") > 0 _
        Then ComboList = ListJoin(ComboList, CLApp)
    If WorksheetFunction.CountIf(Range("A2:A4"), "Pears") > 0 _
        Then ComboList = ListJoin(ComboList, CLPea)
    If WorksheetFunction.CountIf(Range("A2:A4"), "Oranges") > 0 _
        Then ComboList = ListJoin(ComboList, CLOra)

    If Not Application.Intersect(Target, Range("A2:A4")) Is Nothing Then
        Call UpdateCombo(Target, CLAll)
    End If
    Call UpdateCombo(Range("A6"), ComboList)

ExitFunction:
End Function

Private Function UpdateCombo(ByVal Target As Range, ComboList As String)
    With Target.Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=ComboList
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    If InStr(ComboList, Target.Value) = 0 Then Target.Value = ""
End Function

Private Function ListJoin(Str1 As String, Str2 As String) As String
    If Str2 = "" Then ListJoin = Str1
    If Str1 = "" And ListJoin = "" Then ListJoin = Str2
    If ListJoin = "" Then ListJoin = Str1 & "," & Str2
End Function