VBA可在多个复选框上显示结果，并带有；“真的”；条件

我设计了一个useform，listbox有多个选项

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

如果复选框“Germany”为true，则应在“L”列的我的工作表“Result”中过滤德国的结果。如果复选框“选中德国和美国”，则我希望对我的工作表中的两个位置的结果进行过滤

在网上冲浪时，我发现了这样一个代码：这与复选框一起工作，我应该如何修改这个具有多个选项的列表框

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

这与复选框一起工作，我应该如何修改具有多个选项的列表框，如下图所示

---

任何线索都会有帮助

这可能会对您有所帮助

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"

试一试

---

在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

---

看一看。它有用吗？我有一个疑问，我正在根据我的选择进行过滤，但我也得到了空行，我不想要它们，我只想在列L中显示包含schwalnach的所有行。Thomas还有，我的标题在第4行消失了我忘了添加

Redim

（为了去除空元素），请参阅我的答案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