VBA 多选列表框,用所选项目填充列
VBA multiselect listbox, populate column with selected items
我有一个多选列表框,其中填充了来自另一个 sheet 的唯一城市名称。它在列表中只有一列数据。它填充了下面的代码,这些代码是在一些可爱的堆栈交换人员的帮助下开发的。
从这个列表框中,我想将用户选择的项目填充到相同的 sheet 列中。我很确定这只是几行代码,但我不确定如何去做,我在计算列表中选定的项目方面没有任何成功。
非常感谢任何帮助。
干杯
Sub FilterUniqueData_multi()
Dim Lrow As Long, test As New Collection
Dim Value As Variant, temp() As Variant
ReDim temp(0)
Dim Value1 As Variant
Dim endrow As Long
On Error Resume Next
Set Billed_sheet = Workbooks("Billed_customers.xlsx").Sheets("Non Household Metered Users")
With Billed_sheet
'clear formatting to get rid of merging
.Range("a:v").ClearFormats
endrow = .Range("a" & .Rows.count).End(xlUp).Row
.Range("A2:v" & endrow).Sort _
Key1:=.Range("h2"), Order1:=xlAscending 'essential to qualify the range on both lines with '.'
temp = .Range("h2:h" & endrow).Value
End With
For Each Value In temp
If Len(Value) > 0 Then test.Add Value, CStr(Value)
Next Value
ReDim temp(0)
Workbooks("DMA_metered_tool_v4.xlsm").Worksheets("DMA list").Shapes("DMA_listbox").ControlFormat.RemoveAllItems
For Each Value In test
Worksheets("DMA list").Shapes("DMA_listbox").ControlFormat.AddItem Value
Next Value
Set test = Nothing
Worksheets("DMA list").Shapes("DMA_listbox").ControlFormat.MultiSelect = xlSimple
End Sub
您需要迭代列表中的项目,检查 .Selected
属性,然后在适当的情况下输出该列表值:
Sub Outputdata()
Dim wsList As Worksheet
Dim lb As ListBox
Dim n As Long
Set wsList = Workbooks("DMA_metered_tool_v4.xlsm").Worksheets("DMA list")
Set lb = wsList.ListBoxes("DMA_listbox")
For n = 1 To lb.ListCount
If lb.Selected(n) Then
wsList.Cells(wsList.Rows.Count, "A").End(xlUp).Offset(1).Value = lb.List(n)
End If
Next n
End Sub
我有一个多选列表框,其中填充了来自另一个 sheet 的唯一城市名称。它在列表中只有一列数据。它填充了下面的代码,这些代码是在一些可爱的堆栈交换人员的帮助下开发的。
从这个列表框中,我想将用户选择的项目填充到相同的 sheet 列中。我很确定这只是几行代码,但我不确定如何去做,我在计算列表中选定的项目方面没有任何成功。
非常感谢任何帮助。
干杯
Sub FilterUniqueData_multi()
Dim Lrow As Long, test As New Collection
Dim Value As Variant, temp() As Variant
ReDim temp(0)
Dim Value1 As Variant
Dim endrow As Long
On Error Resume Next
Set Billed_sheet = Workbooks("Billed_customers.xlsx").Sheets("Non Household Metered Users")
With Billed_sheet
'clear formatting to get rid of merging
.Range("a:v").ClearFormats
endrow = .Range("a" & .Rows.count).End(xlUp).Row
.Range("A2:v" & endrow).Sort _
Key1:=.Range("h2"), Order1:=xlAscending 'essential to qualify the range on both lines with '.'
temp = .Range("h2:h" & endrow).Value
End With
For Each Value In temp
If Len(Value) > 0 Then test.Add Value, CStr(Value)
Next Value
ReDim temp(0)
Workbooks("DMA_metered_tool_v4.xlsm").Worksheets("DMA list").Shapes("DMA_listbox").ControlFormat.RemoveAllItems
For Each Value In test
Worksheets("DMA list").Shapes("DMA_listbox").ControlFormat.AddItem Value
Next Value
Set test = Nothing
Worksheets("DMA list").Shapes("DMA_listbox").ControlFormat.MultiSelect = xlSimple
End Sub
您需要迭代列表中的项目,检查 .Selected
属性,然后在适当的情况下输出该列表值:
Sub Outputdata()
Dim wsList As Worksheet
Dim lb As ListBox
Dim n As Long
Set wsList = Workbooks("DMA_metered_tool_v4.xlsm").Worksheets("DMA list")
Set lb = wsList.ListBoxes("DMA_listbox")
For n = 1 To lb.ListCount
If lb.Selected(n) Then
wsList.Cells(wsList.Rows.Count, "A").End(xlUp).Offset(1).Value = lb.List(n)
End If
Next n
End Sub