VBA - Excel - 应用过滤器后返回空白表的代码

问：

我已经编写了一个 VBA 代码来自动过滤 2 个条件，并且它运行良好。唯一的问题是，如果第二个 citeria 不是，它会返回一张空白纸，然后我必须清除过滤器才能取回我的数据。我想修改代码，以便它只处理我的消息框并原封不动地返回我的工作表。

Sub filter_Available()

Dim strInput As String
Dim fltrdrng As Range
Dim lUpper As Long
Dim LstRow2 As Long
Dim j As Integer
Dim r As Range

Sheets("Available").Select
Set r = Range(Range("D1"), Range("D1").End(xlDown))

    strInput = InputBox("Enter The Project Code")
    
    
    ActiveSheet.Range("A:D").AutoFilter Field:=1, Criteria1:=strInput
    ActiveSheet.Range("A:D").AutoFilter Field:=2, Criteria1:=Sheets("Requirement").Range("G2").Value
    
    j = WorksheetFunction.Count(r.Cells.SpecialCells(xlCellTypeVisible))
    If j = 0 Then
    
        MsgBox "The ICD was not found"
        Exit Sub
        
        Else: If j > 0 Then Set fltrdrng = Intersect(ActiveSheet.UsedRange, ActiveSheet.UsedRange.Offset(1)).SpecialCells(xlCellTypeVisible)
        lUpper = UBound(Split(fltrdrng.Address, "$"))
    
        LstRow2 = Split(fltrdrng.Address, "$")(lUpper)
        Range("A2:D" & LstRow2).Copy (Sheets("TempAvail").Range("A1"))
        
     End If
    
    
End Sub

Excel VBA

Sub filter_Available()
    Dim criterialValue1 As String
    Dim criterialCell2 As Range
    Dim fltrdrng As Range
    Dim lUpper As Long
    Dim LstRow2 As Long
    Dim j As Integer
    Dim r As Range
    Dim r2 As Range
    Dim firstCellofLastCol As Range
    Dim selectedRange As Range
    Dim availableSheetName As String
    Dim firtColName As String
    Dim lastColName As String
    Dim destSheet As Object
    Dim activeSheet As Object
    
    ' Params
    availableSheetName = "Available"
    firtColName = "A"
    lastColName = "D"
    Set criterialCell2 = Sheets("Requirement").Range("G2")
    Set destSheet = Sheets("TempAvail")

    destSheet.Cells.Clear
    
    Set activeSheet = Sheets(availableSheetName)
    Set firstCellofLastCol = activeSheet.Range(lastColName + "1")
    Set r = activeSheet.Range(firstCellofLastCol, firstCellofLastCol.End(xlDown))
    'r.Cells.Select
    'MsgBox Str(WorksheetFunction.Count(r.Cells))
    
    criterialValue1 = InputBox("Enter The Project Code")
    
    Set selectedRange = activeSheet.Range(firtColName + ":" + lastColName)
    selectedRange.AutoFilter Field:=1, Criteria1:=criterialValue1
    selectedRange.AutoFilter Field:=2, Criteria1:=criterialCell2.Value
    
    Set r2 = activeSheet.Range(firstCellofLastCol.Offset(1, 0), firstCellofLastCol.End(xlDown))
    
    'j = WorksheetFunction.Count(r2.Cells.SpecialCells(xlCellTypeVisible))
    j = WorksheetFunction.CountA(r2.Cells.SpecialCells(xlCellTypeVisible))
    'MsgBox Str(j)
    
    If j = 0 Then
        MsgBox "The ICD was not found"
    ElseIf j > 0 Then
        Set fltrdrng = Intersect(activeSheet.UsedRange, activeSheet.UsedRange.Offset(1)).SpecialCells(xlCellTypeVisible)
        lUpper = UBound(Split(fltrdrng.Address, "$"))
    
        LstRow2 = Split(fltrdrng.Address, "$")(lUpper)
        activeSheet.Range("A2:" + lastColName & LstRow2).Copy (Sheets("TempAvail").Range("A1"))
     End If
     
     activeSheet.AutoFilterMode = False
End Sub

PS：我不知道为什么，但是WorksheetFunction.Count对我不起作用：我用WorksheetFunction.CountA替换了它

VBA - Excel - 应用过滤器后返回空白表的代码 - 找不到条件条件

VBA - Excel - Code returning blank sheet after applying filter - condition Criteria is not found

评论

评论