Question

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

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

A栏：水果，蔬菜，肉类，乳制品（他们可以选择上述任何一种，并将其作为（水果，蔬菜）存放在细胞中。他们可以回来说他们想要取消选择水果并添加肉然后它将被存储为（蔬菜，肉）。

B栏：水果选项为（F1，F2，F3）蔬菜（V1，V2，V3）肉类（M1，M2，M3）和乳品（D1，D2，D3）等。

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

为什么我这样做？我需要创建一个仪表板来显示选择A列中的值的次数和选择B列中的值的次数，以及未选择哪些值，将它们全部放在一列中我认为更容易而不是每个值的单独列，用户输入＆＃39; x＆＃39;如果适用的话

我愿意接受更好的方法。

非常感谢任何协助。

谢谢！

我的代码到目前为止：

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

有没有人知道如何根据另一个多选下拉菜单在Excel中创建多选下拉列表？

1 个答案: