vba 在excel vba中循环列表框
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18706409/
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
Loop through listboxes in excel vba
提问by user2759430
Is there an apparent problem with the following codes? I want to loop through all listboxes and populate selected items.
以下代码是否有明显问题？我想遍历所有列表框并填充所选项目。
Dim lRw As Integer
Dim iX As Integer, iY As Integer
Dim i As Integer
For i = 1 To 10
With ActiveSheet
.Columns(i + 10).ClearContents
End With
For iX = 0 To ListBox(i).ListCount - 1
If ListBox(i).Selected(iX) = True Then
With Sheet1
lRw = .Cells(.Rows.Count, i + 11).End(xlUp).Row + 1
For iY = 0 To ListBox(i).ColumnCount - 1
.Cells(lRw, iY + i).Value = ListBox(i).List(iX, iY)
Next iY
End With
End If
Next iX
Next i
回答by tigeravatar
With an unkown number of listboxes and an unknown number of selected items each, I would build a string with the results, then split the string on carriage returns Chr(10)for each line (each selected item in a listbox) and then use a text to columns to get everything in the correct cells. It would look like this:
使用未知数量的列表框和未知数量的选定项目，我将构建一个带有结果的字符串，然后在Chr(10)每行（列表框中的每个选定项目）的回车符上拆分字符串，然后使用文本到列在正确的单元格中获取所有内容。它看起来像这样：
Sub tgr()
Dim wsLists As Worksheet
Dim wsDest As Worksheet
Dim ctrl As OLEObject
Dim strOutput As String
Dim arrOutput() As String
Dim i As Long, j As Long
Set wsLists = Sheets("Sheet1") 'The sheet containing the listboxes
Set wsDest = Sheets("Sheet2") 'The sheet where the output will go
For Each ctrl In wsLists.OLEObjects
If TypeName(ctrl.Object) = "ListBox" Then
For i = 0 To ctrl.Object.ListCount - 1
If ctrl.Object.Selected(i) Then
If Len(strOutput) > 0 Then strOutput = strOutput & Chr(10)
For j = 0 To ctrl.Object.ColumnCount - 1
strOutput = strOutput & ctrl.Object.List(i, j) & vbTab
Next j
End If
Next i
End If
Next ctrl
If Len(strOutput) > 0 Then
wsDest.Range("K:T").ClearContents
arrOutput = Split(strOutput, Chr(10))
With wsDest.Cells(Rows.Count, "K").End(xlUp).Offset(1).Resize(UBound(arrOutput) - LBound(arrOutput) + 1)
.Value = Application.Transpose(arrOutput)
.TextToColumns Tab:=True
End With
Erase arrOutput
End If
End Sub
