excel - VBA - 从多个 ListObjects 填充 ListBox
问题描述
我正在尝试使用来自多个 ListObjects 的条目填充 ListBox。但并非所有条目都应该被填充,只有那些在 ListObject 的列中具有特定值的条目。
示例:ListObjects 由 3 列组成:[Name]、[Size]、[Position]
如果 [Position] 列中的值为“Top”,则从 ListObject1 到 ListObject5 的所有条目都应填充到 ListBox 中。
基于该结果的下一个问题:然后我如何在第二个 ListBox 中显示依赖 ListObject 的所有条目,其中 [Position] 不是“Top”。换句话说,并非所有 ListObjects 中不是“Top”的所有条目都应显示在第二个 LIstBox 中,只有来自特定 ListObject 的那些可能条目显示在第一个 ListBox 中选取的值匹配。
我的想法可能很奇怪,但是如何创建一个全新的表(可能是一个数组),它包含所有 ListObjects 中的所有条目,这些条目将在打开用户窗体时生成,然后向其中添加第三列 - [ListObjectNumber] - 其中包含该信息来自哪个 Table 的信息,这将有助于第二个 ListBox 仅显示正确的条目......但也许这太超前了。
谢谢您的帮助!
解决方案
在这样布局的电子表格中:
- 通过主页选项卡使用“格式为表格”进行格式化;这将创建自动命名为“Table1”、“Table2”、“Table3”、“Table4”、“Table5”的 ListObjects
- 例如名为“列表框”的工作表
在此示例中添加了 ActiveX 命令按钮以显示名为 frmListbox 的用户表单:
Sub Button2_Click() frmListbox.Show End Sub
Private Sub cmdPopulate_Click()
Dim ws As Worksheet
Dim table As ListObject
Dim rng As Range
Dim i As Long, j As Long, criteriaRow As Long, lastCol As Long
Dim myarray() As String
With Me.lbUsed
'Set relevant sheetname (or create loop for worksheets)
Set ws = Sheets("listbox")
criteriaRow = -1
For Each table In ws.ListObjects
'Set relevant range/table
'Remember: top row are headings
Set rng = ws.Range(table)
'Remember: last colum not displayed in listbox (-1) for this example
lastCol = rng.Columns.Count - 1
.Clear
.ColumnHeads = False
.ColumnCount = lastCol
'Remember: leave out row 0; column headings
For i = 1 To rng.Rows.Count
If (rng.Cells(i, 3) = "Top") Then
criteriaRow = criteriaRow + 1
'Columns go in first demension so that rows can resize as needed
ReDim Preserve myarray(lastCol, criteriaRow)
For j = 0 To lastCol
myarray(j, criteriaRow) = rng.Cells(i, j + 1)
Next 'Column in table
End If
Next 'Row in table
Next 'Table (ListObject)
'Place array in natural order to display in listbox
.List = TransposeArray(myarray)
'Set the widths of the column, separated with a semicolon
.ColumnWidths = "100;75"
.TopIndex = 0
End With
End Sub
Public Function TransposeArray(myarray As Variant) As Variant
Dim X As Long
Dim Y As Long
Dim Xupper As Long
Dim Yupper As Long
Dim tempArray As Variant
Xupper = UBound(myarray, 2)
Yupper = UBound(myarray, 1)
ReDim tempArray(Xupper, Yupper)
For X = 0 To Xupper
For Y = 0 To Yupper
tempArray(X, Y) = myarray(Y, X)
Next Y
Next X
TransposeArray = tempArray
End Function
对于第二个问题:
下面的代码示例显示了当单击名为 lstDisorder 的列表中的项目时,如何使用电子表格上命名范围的值填充名为 lstTreatment 的下一个列表框。
Private Sub lstDisorder_Click()
Dim x As Integer
x = lstDisorder.ListIndex
Select Case x
Case Is = 0
lstTreatment.RowSource = "Depression"
Case Is = 1
lstTreatment.RowSource = "Anxiety"
Case Is = 2
lstTreatment.RowSource = "OCD"
Case Is = 3
lstTreatment.RowSource = "Stubstance"
End Select
End Sub
这是另一种方法:
Private Sub lstTeam_Click()
Dim colUniqueItems As New Collection
Dim vItem As Variant
Dim rFound As Range
Dim FirstAddress As String
'First listBox
Me.lstItems.Clear
'populate first listBox from range on worksheet
With Worksheets("Team").Range("A2:A" & (Cells(1000, 1).End(xlUp).row))
'Find what was clicked in first listBox
Set rFound = .Find(what:=lstTeam.Value, LookIn:=xlValues, lookat:=xlWhole)
'If something is selected, populate second listBox
If Not rFound Is Nothing Then
'Get the address of selected item in first listBox
FirstAddress = rFound.Address
On Error Resume Next
Do
'Add the value of the cell to the right of the cell selected in first listBox to the collection
colUniqueItems.Add rFound.Offset(, 1).Value, CStr(rFound.Offset(, 1).Value)
'Find the next match in the range of the first listBox
Set rFound = .FindNext(rFound)
'Keep looking through the range until there are no more matches
Loop While rFound.Address <> FirstAddress
On Error GoTo 0
'For each item found and stored in the collection
For Each vItem In colUniqueItems
'Add it to the next listBox
Me.lstItems.AddItem vItem
Next vItem
End If
End With
End Sub
这是关于 listBox 的一个很好的资源,它展示了如何从数组中填充 ListBox以及如何从 ListBox1 到 ListBox2 中获取选定的项目等等。
推荐阅读
- docker - Dockerized elasticsearch and fscrawler:未能创建elasticsearch客户端,禁用爬虫......连接被拒绝
- php - 在 PHP 中从 cURL 请求解析 XML
- windows - Firebird DB 日志文件位于 Windows 中的什么位置?
- java - 一个执行器中有多少并发任务,Spark 如何处理一个执行器中的任务之间的多线程?
- typescript - 打字稿:无效联合类型
- laravel - 使用存储在 redis 中的模型中的水合物来保留雄辩的关系
- momentjs - 如何根据行程预订时间查找 24 小时差异
- flutter - 如何自动更新文本小部件 - Flutter
- ios - SwiftUI:如果刚刚查看,则无法删除列表项
- c - 从更大的数字中获取数字的最有效(速度)方法是什么?