需要知道是否可以在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
答案 0 :(得分:0)
多重选择代码的最佳位置在Contextures网站上结束。见http://www.contextures.com/excel-data-validation-multiple.html