结合下拉条件筛选数据表vba
结合下拉条件筛选数据表vba
提问于 2019-09-29 20:31:50
我有一个投注工作簿，我希望能够根据4个不同的周标准来过滤我的数据表。我的过滤器目前起作用，所以当我输入四个不同的周数字时，我就会得到正确的结果。但是，我的datatable只显示了其中一个星期数字。已经试着把这周的不。标准，但没有运气。
Private Sub Worksheet_Change(ByVal Target As Range)
'Year Criteria
If Target.Address = "$C$1" Then
If Target.Value = "All" Then
Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=1
Else
Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=1, Criteria1:=Target.Value
End If
'Tournament Criteria
ElseIf Target.Address = "$C$2" Then
If Target.Value = "All" Then
Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=3
Else
Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=3, Criteria1:=Target.Value
End If
'Week Criteria 1
ElseIf Target.Address = "$C$3" Then
If Target.Value = "All" Then
Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=2
Else
Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=2, Criteria1:=Target.Value
End If
'Week Criteria 2
ElseIf Target.Address = "$C$4" Then
If Target.Value = "All" Then
Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=2
Else
Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=2, Criteria1:=Target.Value
End If
'Week Criteria 3
ElseIf Target.Address = "$C$5" Then
If Target.Value = "All" Then
Worksheets("Ark1").ListObjects("Tabek1").Range.AutoFilter Field:=2
Else
Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=2, Criteria1:=Target.Value
End If
'Week Criteria 4
ElseIf Target.Address = "$C$6" Then
If Target.Value = "All" Then
Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=2
Else
Worksheets("Ark1").ListObjects("Tabel1").Range.AutoFilter Field:=2, Criteria1:=Target.Value
End If
End If
End Sub回答 1
Stack Overflow用户
发布于 2019-09-30 17:44:14
这是一个很多人似乎都在努力解决的问题，但您可以通过将多个条件首先添加到数组中来过滤范围，如下所示：
Sub autofilter_range()
Dim filtur(1 To 4) As Variant
filtur(1) = "1"
filtur(3) = "3"
Sheet1.Range("A1:C7").AutoFilter field:=2, Criteria1:=filtur, Operator:=xlFilterValues
End Sub这将创建一个从第1周到第4周的数组，然后将值添加到数组中的相关位置。(在本例中为1和3)，然后仅在这几周内应用自动筛选。
但是，当前自动筛选的方式(在工作表更改时，基于最近编辑的单元格)在应用多个条件时效率非常低。我建议您将这些单元格替换为勾选框，并根据它们是否被勾选将值添加到数组中：
If Sheets("Sheet1").CheckBox1.Value = True Then filtur(1) = "1"这将在一个去检查所有的复选框，并适用于哪些是票证的过滤器，并给你一个完整的清单所需的。
EDIT复选框选项的更深入的解释:最好将此代码移动到模块中，而不是工作表函数中。然后从每个复选框中调用它，如下所示：
Private Sub CheckBox1_Change()
autofilter_range()
end subsub中的代码将如下所示：
Sub autofilter_range()
Dim filtur(1 To 4) As Variant
If Sheets("Sheet1").CheckBox1.Value = True Then filtur(1) = "1"
If Sheets("Sheet1").CheckBox1.Value = True Then filtur(2) = "2"
If Sheets("Sheet1").CheckBox1.Value = True Then filtur(3) = "3"
If Sheets("Sheet1").CheckBox1.Value = True Then filtur(4) = "4"
Sheet1.Range("A1:C7").AutoFilter field:=2, Criteria1:=filtur, Operator:=xlFilterValues
End Sub这会将自动筛选应用于选中的每周复选框。至于年份，最好将年份添加到下拉列表中并从中进行选择，并将缺省值(空白)设置为所有年份。在上面的自动筛选之后添加第二个自动筛选：
Dim year as string: year = Range("whichever range your dropdown is in").value
If Not year = "" Then
Sheet1.Range("A1:C7").AutoFilter field:=1, Criteria1:=year, Operator:=xlFilterValues
Else
Sheet1.Range("A1:C7").AutoFilter field:=1
End If页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/58155234
复制相关文章
相似问题
腾讯云开发者
