Excel VBA多选下拉列表 [英] Excel VBA multi select drop down list
问题描述
我正在尝试使用Excel VBA创建多选下拉列表.我有Sheet1的以下代码.
I am trying to create a multi select dropdown list with Excel VBA. I have the following code for Sheet1.
With Range("B27").Validation
.Delete
End With
With Range("B27")
.Value = "[Select from drop down]"
End With
With Range("B27").Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,Formula1:="=DropDownList_data!D1:D3")
.IgnoreBlank = True
End With
DropDownList_data选项卡中的单元格D1,D2和D3分别包含文本Item1,Item2,Item3.通过在Worksheet_Change事件中编写代码,我将其变成了一个多选列表.当我连续选择3个项目时,Item1,Item2,Item3出现在单元格B27中.但是,当我从单元格中手动删除,Item3时,出现以下错误.此值与为此单元格定义的数据验证限制不匹配."
Cells D1, D2 and D3 in the DropDownList_data tab contain the text Item1,Item2,Item3 respectively. I have made this a multi select list by writing code in the Worksheet_Change event. When I select the 3 items consecutively, Item1,Item2,Item3 appears in Cell B27. However, when I manually delete ,Item3 from the cell the following error appears. "This value doesn't match the data validation restrictions defined for this cell."
以下是Worksheet_Change事件中的代码.
The following is the code in the Worksheet_Change event.
Dim Newvalue, Oldvalue As String
On Error GoTo Exitsub
Application.EnableEvents = False
If Target.Address="$B$27" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Or Oldvalue = "[Select from drop down]" Then
Target.Value = Newvalue
Else
Dim strArray() As String
strArray = Split(Oldvalue, ",")
If IsInArray(Newvalue, strArray) Then
Target.Value = Oldvalue
Else
Target.Value = Oldvalue & "," & Newvalue
End If
End If
End If
End If
Exitsub:
Application.EnableEvents = True
选择一个项目后如何手动删除它?
How can I manually delete an item after I have selected it?
推荐答案
执行此类操作的技巧是,您无法手动编辑单元格内容并尝试删除部分选择列表,除非您在列表中保留一个空单元格或单个值.
The trick when doing this type of thing is you can't manually edit the cell content and try to remove part of the list of selections, unless you're leaving an empty cell or a single value from the list.
删除已选择的值的典型方法是从列表中再次选择它,并让事件处理程序将其从单元格中的列表中删除.
The typical approach to remove a value you already selected is to select it again from the list and have the event handler remove it from the list in the cell.
Private Sub Worksheet_Change(ByVal Target As Range)
' To allow multiple selections in a Drop Down List
Dim Oldvalue As String
Dim Newvalue As String
Dim rng As Range, srcRange As Range, arr, listVals
'run some checks
Set rng = Application.Intersect(Target, Me.Range("B27"))
If rng Is Nothing Then Exit Sub
Newvalue = rng.Value
If Len(Newvalue) = 0 Then Exit Sub
If rng.Value <> "" Then
On Error GoTo Exitsub
Application.EnableEvents = False
Application.Undo
Oldvalue = rng.Value
If Oldvalue = "" Then
rng.Value = Newvalue
Else
listVals = Application.Evaluate(rng.Validation.Formula1).Value
rng.Value = SortItOut(listVals, Oldvalue, Newvalue) '<< call function
End If
End If
Exitsub:
If Err.Number > 0 Then Debug.Print Err.Description
Application.EnableEvents = True
End Sub
Private Function SortItOut(listVals, oldVal, newVal)
Const LIST_SEP As String = ", "
Dim i As Long, arr, s, sep, t, listed, removeNewVal
s = ""
sep = ""
arr = Split(oldVal, LIST_SEP)
'new value already listed?
removeNewVal = Not IsError(Application.Match(newVal, arr, 0))
For i = 1 To UBound(listVals, 1)
t = listVals(i, 1)
listed = Not IsError(Application.Match(t, arr, 0))
If listed Or newVal = t Then
If Not (removeNewVal And newVal = t) Then
s = s & sep & t
sep = LIST_SEP
End If
End If
Next i
SortItOut = s
End Function
这篇关于Excel VBA多选下拉列表的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!