在Excel中动态生成多选下拉列表

时间:2018-01-30 06:12:32

标签: excel vba excel-vba

需要知道是否可以在Excel中创建多选下拉列表,然后动态链接到另一个多选下拉列表。

例如,考虑两列,即国家和城市,如下所示

India -> Delhi, Mumbai, Bangalore;
Australia -> Sydney, Hobart, Brisbane, Perth;
USA -> CA, NYC, LA;
Pakistan -> Lahore, Karachi, Peshawar

如果我在第一次下拉菜单中选择印度和澳大利亚,我应该可以选择在德里,孟买,班加罗尔,悉尼,霍巴特,布里斯班和珀斯选择一个或多个选项。

编辑:我已经能够创建一个多选下拉列表和一个选择下拉列表,根据父列中选择的单个值动态更新。我无法将两者结合起来

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Oldvalue As String
    Dim Newvalue As String
    Dim Extract As String
'Dim arr As Variant
Dim i As Integer
Dim ComboList As String

Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 8 Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else: If Target.Value = "" Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & ", " & Newvalue
      Else:
        Target.Value = Oldvalue
      End If
    End If
  End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True

If Target.Column = 9 Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else: If Target.Value = "" Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & ", " & Newvalue
      Else:
        Target.Value = Oldvalue
      End If
    End If
   End If


    TargetRow = ActiveCell.Row
    MsgBox (TargetRow)
    TargetCol = ActiveCell.Column

    Dim CLInd As String: CLInd = "Delhi, Mumbai, Bangalore"
    Dim CLAus As String: CLAus = "Sydney, Hobart, Perth, Brisbane"
    Dim CLPak As String: CLPak = "Lahore, Karachi, Peshawar"
    Dim CLNZ As String: CLNZ = "Auckland,Wellington"
    Dim CLUSA As String: CLUSA = "CA, LA, DC"


    Extract = Index(A2:J10, TargetRow - 1, 9)




    If InStr(1, Extract, "IND") <> 0 Then
       ComboList = ListJoin(ComboList, CLInd)
    End If

    If InStr(1, Extract, "AUS") <> 0 Then ComboList = ListJoin(ComboList, CLAus)
    End If

    If InStr(1, Extract, "PAK") <> 0 Then ComboList = ListJoin(ComboList, CLPak)
    End If

    If InStr(1, Extract, "NZ") <> 0 Then ComboList = ListJoin(ComboList, CLNZ)
    End If

    If InStr(1, Extract, "USA") <> 0 Then ComboList = ListJoin(ComboList, CLUSA)
    End If

  End If 'target column=9

  Call UpdateCombo(Target.Value, ComboList)  'target.value or target.range

End Sub

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

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

1 个答案:

答案 0 :(得分:0)

多重选择代码的最佳位置在Contextures网站上结束。见http://www.contextures.com/excel-data-validation-multiple.html