自动筛选器不返回任何行，因此可见范围为空，但过滤后的可见范围不是空的。
自动筛选器不返回任何行，因此可见范围为空，但过滤后的可见范围不是空的。
提问于 2021-12-30 15:42:30
因此，这是代码的相关部分：
i = Feuil1.Cells.Rows.count
i = Feuil1.Cells(i, 1).End(xlUp).Row
j = Feuil1.Cells(1, 1).End(xlToRight).Column
HelpAddress = Feuil1.Cells(i, j).Address
Set Table = Feuil1.ListObjects("FiltersTable")
HelpArr = Application.WorksheetFunction.Transpose(Table.ListColumns("Rubriques").DataBodyRange)
HelpArr2 = Application.WorksheetFunction.Transpose(Table.ListColumns("Departements").DataBodyRange)
HelpArr = UniqueNoEmpty(HelpArr)
HelpArr2 = UniqueNoEmpty(HelpArr2)
For i = LBound(HelpArr2) To UBound(HelpArr2)
HelpArr2(i) = CStr(HelpArr2(i)) & "*"
Next i
FilterArray2 = Array("*@*")
Set Wbk = Workbooks.Add
Set Ws = Wbk.Worksheets(1)
Feuil1.Activate
Feuil1.Range("A1" & ":" & Feuil1.Cells(1, j).Address).Copy
Ws.Cells(1, 1).PasteSpecial xlPasteValues
For Each Rubrique In HelpArr
FilterArray = Array(Rubrique & "*")
With Feuil1
On Error Resume Next
.ShowAllData
On Error GoTo 0
' .Range("A1" & ":" & HelpAddress).AutoFilter Field:=11
.Range("A1" & ":" & HelpAddress).AutoFilter Field:=11, Criteria1:=FilterArray, Operator:=xlFilterValues
.Range("A1" & ":" & HelpAddress).AutoFilter Field:=9, Criteria1:=FilterArray2, Operator:=xlFilterValues
' .Range("A1" & ":" & HelpAddress).AutoFilter Field:=4, Criteria1:=FilterArray3, Operator:=xlFilterValues, Operator:=xlOr
End With
For i = LBound(HelpArr2) To UBound(HelpArr2)
Feuil1.Range("A1" & ":" & HelpAddress).AutoFilter Field:=4
Feuil1.Range("A1" & ":" & HelpAddress).AutoFilter Field:=4, Criteria1:=HelpArr2(i), Operator:=xlFilterValues
Set FilteredRng = Feuil1.Range("A2" & ":" & HelpAddress).SpecialCells(xlCellTypeVisible)
If Not FilteredRng Is Nothing Then
FilteredRng.Copy
Set HelpRng = Ws.Cells(Ws.Cells.Rows.count, 1).End(xlUp)
Do While HelpRng.Value <> ""
Set HelpRng = HelpRng.Offset(1, 0)
Loop
Ws.Range(HelpRng.Address).PasteSpecial xlPasteValues
End If
Next i
Next RubriqueFeuil1中的第一行是带有过滤器的标题行。
问题是，当Criteria1没有给出任何行作为结果，所以唯一可见的行是带过滤器的行时，在这种情况下，可见范围没有什么，但是FilteredRng is Nothing给出的结果是假的，因为出于某种原因，FilteredRng实际上是带有过滤器的第一行。
我不明白这是如何发生的，因为第一行不是范围的一部分。
此外，它还防止我使用if FilteredRng is Nothing then捕获错误。
现在解决这个问题的方法是if FilteredRng.rows.count = 1 and FilteredRng.row=1 then，但是我仍然希望能够通过与无进行比较来捕获错误，因为过滤器行/标题行可能会在不同情况下更改行.我有一些预先构建好的函数和子程序，用于一般情况下的使用，与之相比，我什么也不做。
如果有人知道这里发生了什么，或者如何捕捉“找不到”错误，我会非常感激的。
更新：
在更新了Rory的注释之后的代码之后，现在的代码是这样的：
On Error Resume Next
Feuil1.ShowAllData
On Error GoTo 0
i = Feuil1.Cells.Rows.count
i = Feuil1.Cells(i, 1).End(xlUp).Row
j = Feuil1.Cells(1, 1).End(xlToRight).Column
HelpAddress = Feuil1.Cells(i, j).Address
Set Wbk = Workbooks.Add
Set Ws = Wbk.Worksheets(1)
Feuil1.Activate
Feuil1.Range("A1:" & Feuil1.Cells(1, j).Address).Copy
Ws.Cells(1, 1).PasteSpecial xlPasteValues
Set Table = Feuil1.ListObjects("FiltersTable")
HelpArr = Application.WorksheetFunction.Transpose(Table.ListColumns("Rubriques").DataBodyRange)
HelpArr2 = Application.WorksheetFunction.Transpose(Table.ListColumns("Departements").DataBodyRange)
HelpArr = UniqueNoEmpty(HelpArr)
HelpArr2 = UniqueNoEmpty(HelpArr2)
For i = LBound(HelpArr2) To UBound(HelpArr2)
HelpArr2(i) = CStr(HelpArr2(i)) & "*"
Next i
FilterArray2 = Array("*@*")
For Each Rubrique In HelpArr
FilterArray = Array(Rubrique & "*")
With Feuil1
On Error Resume Next
.ShowAllData
On Error GoTo 0
' .Range("A1" & ":" & HelpAddress).AutoFilter Field:=11
.Range("A1" & ":" & HelpAddress).AutoFilter Field:=11, Criteria1:=FilterArray, Operator:=xlFilterValues
.Range("A1" & ":" & HelpAddress).AutoFilter Field:=9, Criteria1:=FilterArray2, Operator:=xlFilterValues
' .Range("A1" & ":" & HelpAddress).AutoFilter Field:=4, Criteria1:=FilterArray3, Operator:=xlFilterValues, Operator:=xlOr
End With
For i = LBound(HelpArr2) To UBound(HelpArr2)
Set FilteredRng = Nothing
Feuil1.Range("A1" & ":" & HelpAddress).AutoFilter Field:=4
Feuil1.Range("A1" & ":" & HelpAddress).AutoFilter Field:=4, Criteria1:=HelpArr2(i), Operator:=xlFilterValues
On Error Resume Next
Set FilteredRng = Feuil1.Range("A2" & ":" & HelpAddress).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not FilteredRng Is Nothing Then
' If FilteredRng.Rows.count = 1 And FilteredRng.Row = 1 Then
FilteredRng.Copy
Set HelpRng = Ws.Cells(Ws.Cells.Rows.count, 1).End(xlUp)
Do While HelpRng.Value <> ""
Set HelpRng = HelpRng.Offset(1, 0)
Loop
Ws.Range(HelpRng.Address).PasteSpecial xlPasteValues
End If
Next i
Next RubriqueStack Overflow用户
发布于 2021-12-30 16:30:21
参考AutoFilter可见细胞
- 这里是一个如何解决这个问题的例子。
Option Explicit
Sub AutoFilterExample()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
If ws.AutoFilterMode Then ws.AutoFilterMode = False ' remove previous
Dim trg As Range: Set trg = ws.Range("A1").CurrentRegion ' Table Range
Dim dtrg As Range ' Data Range (refernce before the 'AutoFilter')
Set dtrg = trg.Resize(trg.Rows.Count - 1).Offset(1)
trg.AutoFilter 1, "Yes"
Dim vrg As Range ' Visible Range
On Error Resume Next
Set vrg = dtrg.SpecialCells(xlCellTypeVisible) ' use the data range ('dtrg')
On Error GoTo 0
ws.AutoFilterMode = False
If Not vrg Is Nothing Then
Debug.Print vrg.Address(0, 0)
Else
Debug.Print "Nope"
End If
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/70533740
复制相关文章
相似问题
腾讯云开发者
