Question

我正在尝试从Sheet＆＃34; Data＆＃34;中过滤和提取数据。取决于在单独的工作表中输入的多个标准＆＃34;过滤器＆＃34;。但是，正如Sheet＆＃34; Filters＆＃34;中的一些标准字段为空，返回的数据为空。如果有一种方法可以忽略输入的标准之一是否为空并继续使用其他条件进行数据过滤并返回数据？以下是我到目前为止编写的代码：

Sub CopyPastingFilteredData()
Dim wb As Workbook
Set wb = ActiveWorkbook
If Sheets("Data").FilterMode Then
Cells.AutoFilter
End If
'Filtering Data
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=1, Criteria1:=Sheets("Filters").Range("C4").Text
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=50, Criteria1:=Sheets("Filters").Range("C5")
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=19, Criteria1:=Sheets("Filters").Range("C6")
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=5, Criteria1:=Sheets("Filters").Range("C7")
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=51, Criteria1:=Sheets("Filters").Range("C8")
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=20, Criteria1:=Sheets("Filters").Range("C9")
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=23, Criteria1:=Sheets("Filters").Range("C10")
wb.Sheets("Data").Range("A2:BB20000").AutoFilter field:=7, Criteria1:=Sheets("Filters").Range("C11")
'Copying Data post filtering
wb.Sheets("Data").Range("A3:BB20000").Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy

wb.Sheets("Extract").Select
Cells(12, 1).PasteSpecial Paste:=xlPasteValues


Set FilterRange = Nothing
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Data").Select
Sheets("Data").Activate
Cells.AutoFilter
Sheets("Extract").Select
Sheets("Extract").Activate

End Sub

Answer 1

您可以在过滤之前测试单元格是否首先包含数据。我已更改了下面的Filtering Data部分

Sub CopyPastingFilteredData()
Dim wb As Workbook
Dim shF As Worksheet
Set wb = ActiveWorkbook
Set shF = wb.Sheets("Filters")
If Sheets("Data").FilterMode Then
Cells.AutoFilter
End If
'Filtering Data
With wb.Sheets("Data").Range("A2:BB20000")
    If shF.Range("C4").Value <> "" Then .AutoFilter field:=1, Criteria1:=shF.Range("C4").Text
    If shF.Range("C5").Value <> "" Then .AutoFilter field:=50, Criteria1:=shF.Range("C5")
    If shF.Range("C6").Value <> "" Then .AutoFilter field:=19, Criteria1:=shF.Range("C6")
    If shF.Range("C7").Value <> "" Then .AutoFilter field:=5, Criteria1:=shF.Range("C7")
    If shF.Range("C8").Value <> "" Then .AutoFilter field:=51, Criteria1:=shF.Range("C8")
    If shF.Range("C9").Value <> "" Then .AutoFilter field:=20, Criteria1:=shF.Range("C9")
    If shF.Range("C10").Value <> "" Then .AutoFilter field:=23, Criteria1:=shF.Range("C10")
    If shF.Range("C11").Value <> "" Then .AutoFilter field:=7, Criteria1:=shF.Range("C11")
End With
'Copying Data post filtering
wb.Sheets("Data").Range("A3:BB20000").Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy

wb.Sheets("Extract").Select
Cells(12, 1).PasteSpecial Paste:=xlPasteValues


Set FilterRange = Nothing
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Data").Select
Sheets("Data").Activate
Cells.AutoFilter
Sheets("Extract").Select
Sheets("Extract").Activate

End Sub

VBA：如果单元格引用值为空，如何忽略自动筛选

1 个答案: