vba Excel 宏来显示多选列表框的所有选择
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/19274382/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel macro to show all selections of a multi-select listbox
提问by molwiko
I would like to create an Excel sheet file with a list box with multi selection as :
我想创建一个带有多选列表框的 Excel 工作表文件:
item1
item2
item3
item4
...
..
And then when I select for Example item1
and item3
from that listbox the selected items are populated on another cell with display as
然后当我选择 Exampleitem1
并item3
从该列表框中选择的项目填充在另一个单元格上,显示为
item1 - item 2 are selected
The solution that I tried is creating multi-select listbox and I attached a macro to it and then I tried to loop on listbox display selected item to a cell but I didn't know to write the Macro, I am not expert on Excel I need to do this.
我尝试的解决方案是创建多选列表框,并在其上附加了一个宏,然后我尝试将列表框显示所选项目循环到单元格,但我不知道如何编写宏,我不是 Excel 专家我需要这样做。
Thanks in advance
提前致谢
回答by user2140261
This Should Work Given you are starting with a Fresh No Items Selected ListBox. I choose to add and remove items from the already made string, instead of looping every object every selection/deselection for performance reason. That is an option but this should run much smoother. But if you already have items selected in your ListBox this won't account for them until you deselect then re-select them.
鉴于您从一个新的 No Items Selected ListBox 开始,这应该有效。我选择从已经制作的字符串中添加和删除项目,而不是出于性能原因在每次选择/取消选择时循环每个对象。这是一个选项,但这应该运行得更顺畅。但是,如果您已经在 ListBox 中选择了项目,则在您取消选择然后重新选择它们之前,这不会考虑它们。
The other difference between this option and looping all values every time, is that with this method it adds the selections/values in order of when they where selected oppose to in the same order as they are in the ListBox, this could be a positive a negative or indifferent to your purpose but figured I should add that in.
此选项与每次循环所有值之间的另一个区别是,使用此方法,它会按选择/值的顺序添加选择/值,它们的选择顺序与它们在 ListBox 中的顺序相同,这可能是一个积极的对你的目的消极或漠不关心,但我想我应该把它加进去。
Private Sub ListBox1_Change()
Dim lngCurrentItem As Long
Dim strCurrentItem As String
Dim strAllSelectedItems As String
Dim rngOutput As Range
Set rngOutput = [J1]
lngCurrentItem = ListBox1.ListIndex
strAllSelectedItems = rngOutput
strAllSelectedItems = Replace(strAllSelectedItems, " Are Selected", "")
strAllSelectedItems = Replace(strAllSelectedItems, " Is Selected", "")
strCurrentItem = ListBox1.List(lngCurrentItem)
If ListBox1.Selected(lngCurrentItem) Then
If strAllSelectedItems = "No Items Selected" Then
rngOutput = strCurrentItem & " Is Selected"
Else
rngOutput = strAllSelectedItems & " - " & strCurrentItem & " Are Selected"
End If
Else
strAllSelectedItems = Replace(strAllSelectedItems, " - " & strCurrentItem, "")
strAllSelectedItems = Replace(strAllSelectedItems, strCurrentItem, "")
If strAllSelectedItems = "" Then
rngOutput = "No Items Selected"
ElseIf InStr(1, strAllSelectedItems, " - ", vbTextCompare) > 0 Then
rngOutput = strAllSelectedItems & " Are Selected"
Else
rngOutput = strAllSelectedItems & " Is Selected"
End If
End If
End Sub
IF you would like to loop the entire list every time (IF you list box is small enough you won't really notice much of a difference in speed, Just make sure your list box isn't set to like an entire Column with over 1 million cells, and you should be fine)
如果您想每次都循环整个列表(如果您的列表框足够小,您不会真正注意到速度上的太大差异,只需确保您的列表框没有设置为像整个 Column 超过 1百万个细胞,你应该没问题)
Private Sub ListBox1_Change()
Dim lngCurrentItem As Long
Dim strCurrentItem As String
Dim strAllSelectedItems As String
Dim rngOutput As Range
Set rngOutput = [J1]
strAllSelectedItems = ""
For i = 0 To ListBox1.ListCount - 1
strCurrentItem = ListBox1.List(i)
If ListBox1.Selected(i) Then
If strAllSelectedItems = "" Then
strAllSelectedItems = strCurrentItem
Else
strAllSelectedItems = strAllSelectedItems & " - " & strCurrentItem
End If
End If
Next i
If strAllSelectedItems = "" Then
rngOutput = "No Items Selected"
ElseIf InStr(1, strAllSelectedItems, " - ", vbTextCompare) > 0 Then
rngOutput = strAllSelectedItems & " Are Selected"
Else
rngOutput = strAllSelectedItems & " Is Selected"
End If
End Sub