Excel -应用筛选后返回空白工作表的代码-未找到条件Criteria

vx6bjr1n  于 12个月前  发布在  其他
关注(0)|答案(1)|浏览(101)

我已经写了一个自动过滤代码2标准,它是完美的工作.唯一的问题是,如果第二个标准不是,它返回一个空白的工作表,然后我必须清除过滤器,让我的数据回来.我想修改代码,所以它只会处理我的消息框,并返回我的工作表不变.

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

字符串

aemubtdh

aemubtdh1#

你必须在函数结束时清除自动筛选。
另外,您不必计算WorksheetFunction.Count()的第一个单元格,不是吗?

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代替了它

相关问题