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

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 16:51:01  来源:igfitidea点击:

Excel macro to show all selections of a multi-select listbox

excelvbaexcel-vba

提问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 item1and item3from that listbox the selected items are populated on another cell with display as

然后当我选择 Exampleitem1item3从该列表框中选择的项目填充在另一个单元格上,显示为

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