VBA在“真”条件下在多个checkbox上显示结果

我devise了一个带有多个选项的listbox。

列表框中填充了位置。 如：德国，美国等

如果checkbox“德国”是真的，那么它应该在我的工作表“结果”中的“L”列中过滤德国的结果。 如果checkbox“GErmany and USA”被选中，那么我想要为我的表格中的两个位置过滤结果。

通过互联网冲浪，我发现这样的代码：这与checkbox，我应该如何修改这个多选项列表框？

Private Sub Filter() Dim Ws As Worksheet Dim strCriteria() As String Dim arrIdx As Integer Dim cBox As Control arrIdx = 0 For Each cBox In Me.Controls If TypeName(cBox) = "CheckBox" Then If cBox.Value = True Then ReDim Preserve strCriteria(0 To arrIdx) strCriteria(arrIdx) = cBox.Caption arrIdx = arrIdx + 1 End If End If Next cBox Set Ws = ThisWorkbook.Sheets("Result") If arrIdx = 0 Then Ws.UsedRange.AutoFilter Else Ws.Range("A:R").AutoFilter Field:=12, Criteria1:=Array(strCriteria), Operator:=xlFilterValues End If End Sub 

这适用于checkbox，我应该如何修改这个像下面的图像多个选项的列表框

任何领导都会有所帮助

Answer 1

这可能对你有所帮助

 With ListBox1 For x = 0 To .ListCount - 1 If .Selected(x) Then temp = temp & Chr(10) & .List(x) End If Next End With MsgBox temp & " is selected" 

Answer 2

尝试

 Dim strCriteria() As String, i As Integer, arrIdx As Integer ReDim strCriteria(0 To Me.listBoxCountries.ListCount-1) For i = 0 To Me.listBoxCountries.ListCount - 1 If Me.listBoxCountries.Selected(i) Then strCriteria(arrIdx) = Me.listBoxCountries.List(i) arrIdx = arrIdx + 1 End If Next i If arrIdx = 0 Then Ws.UsedRange.AutoFilter Else ReDim preserve strCriteria(arrIdx - 1) Ws.Range("A:R").AutoFilter Field:=12, Criteria1:=Array(strCriteria), Operator:=xlFilterValues End If 

Answer 3

如果您熟悉listbox上的Change事件，只需在这里查看教程。 只有麻烦，应该是你从listboxselect多个项目

Answer 4

在Fun Thomas的帮助下，我编辑了几行他的代码，它适用于我的要求。

这是代码。

 Private Sub DoFilter34() Dim ws As Worksheet Dim strCriteria() As String, i As Integer, arrIdx As Integer ReDim Preserve strCriteria(0 To arrIdx) arrIdx = 0 For i = 0 To Me.ListBox1.ListCount - 1 If Me.ListBox1.Selected(i) Then ReDim Preserve strCriteria(0 To arrIdx) strCriteria(arrIdx) = Me.ListBox1.List(i) arrIdx = arrIdx + 1 End If Next i Set ws = Sheets("Result") If arrIdx = 0 Then ws.UsedRange.AutoFilter Else ws.Range("A:R").AutoFilter Field:=12, Criteria1:=Array(strCriteria), Operator:=xlFilterValues End If End Sub