为什么这个VBA excel与autofilter相关的代码返回一个对象所需的错误？

时间：2018-04-17 08:22:55

标签： excel-vba vba excel

我想知道为什么If Not filteredRangePU Is Nothing Then会返回此错误：

Error

它不应该只是不运行If-Then-End If命令中的内容吗？

Dim Total_rows_Pick as long, Total_rows_Help as long, Total_rows_HelpPU as long, Total_rows_NHI as long
Dim filterRangePU as variant, filteredRangePU as variant, AreaPU as variant
Dim filterRange as variant, filteredRange as variant, Area as variant
Dim q as long, j as long, h as Long, i as long

Total_rows_Pick = Workbooks("Job Production Monitoring.xlsm").Worksheets("Pick-ups").Range("B" & Rows.count).End(xlUp).Row
Total_rows_Help = Worksheets("Help Worksheet").Range("A" & Rows.count).End(xlUp).Row
Total_rows_HelpPU = Worksheets("Help WorksheetPU").Range("A" & Rows.count).End(xlUp).Row
Total_rows_NHI = Worksheets("Non-hourly Input").Range("A" & Rows.count).End(xlUp).Row

'Auto-input of pick ups from data connection from Access
ReDim JO_id(2 To Total_rows_NHI) As Long
ReDim Pick_up_qty(2 To Total_rows_NHI) As Long

For i = 2 To Total_rows_NHI
Total_rows_Pick = Workbooks("Job Production Monitoring.xlsm").Worksheets("Pick-ups").Range("B" & Rows.count).End(xlUp).Row
    h = 1
    If IsError(Application.Match(Worksheets("Non-hourly Input").Cells(i, 5), Worksheets("JO (SunGleam)").Range("B2:B" & Total_rows_JOSgleam), 0)) = False And Worksheets("Non-hourly Input").Cells(i, 6) = "SUNGLEAM" Then
        JO_id(i) = Application.WorksheetFunction.Index(Worksheets("JO (SunGleam)").Range("A2:A" & Total_rows_JOSgleam), Application.WorksheetFunction.Match(Worksheets("Non-hourly Input").Cells(i, 5), Worksheets("JO (SunGleam)").Range("B2:B" & Total_rows_JOSgleam), 0))
        'Filter JO_Pickup (Sgleam) to only display the JO's related to the Non-hourly Input
        Set filterRange = Worksheets("JO_Pickups (SunGleam)").Range("$A$1:$E$" & Total_rows_JOPickSgleam) 'filter for less computations
        filterRange.AutoFilter Field:=2, Criteria1:=JO_id(i)
        On Error Resume Next
        Set filteredRange = Intersect(filterRange, filterRange.Offset(1, 0)).SpecialCells(xlCellTypeVisible) 'remove headers
        On Error GoTo 0
        If Not filteredRange Is Nothing Then
            For Each Area In filteredRange.Areas
                Worksheets("JO_Pickups (SunGleam)").Range(Area.Address).Copy _
                Destination:=Worksheets("Help Worksheet").Cells(2, 1)
            Next Area
            Total_rows_Help = Worksheets("Help Worksheet").Range("A" & Rows.count).End(xlUp).Row
            'Filter Pick-up Worksheet to only display the JO's related to the Non-hourly Input
            Set filterRangePU = Worksheets("Pick-ups").Range("$A$1:$E$" & Total_rows_Pick) 'filter for less computations
            filterRangePU.AutoFilter Field:=4, Criteria1:=Worksheets("Non-hourly Input").Cells(i, 5)
            On Error Resume Next
            Set filteredRangePU = Intersect(filterRangePU, filterRangePU.Offset(1, 0)).SpecialCells(xlCellTypeVisible) 'remove headers
            On Error GoTo 0
            If Not filteredRangePU Is Nothing Then
                For Each AreaPU In filteredRangePU.AreasPU
                    Worksheets("Pick-ups").Range(Area.Address).Copy _
                    Destination:=Worksheets("Help WorksheetPU").Cells(2, 1)
                Next AreaPU
                Total_rows_HelpPU = Worksheets("Help WorksheetPU").Range("A" & Rows.count).End(xlUp).Row
                ReDim z(2 To Total_rows_Help, 2 To Total_rows_NHI)
                For q = 2 To Total_rows_Help
                    For j = 2 To Total_rows_HelpPU
                        If Worksheets("Help WorksheetPU").Cells(j, 5) = Worksheets("Help Worksheet").Cells(q, 1) Then
                            z(q, i) = 1
                        End If
                    Next j
                Next q
                Worksheets("Help WorksheetPU").Range("A2:E" & Total_rows_HelpPU).Clear
            End If
            For q = 2 To Total_rows_Help
                If z(q, i) <> 1 Then
                    Worksheets("Pick-ups").Cells(Total_rows_Pick + h, 1) = Format(Worksheets("Help Worksheet").Cells(q, 3), "short date")
                    Worksheets("Pick-ups").Cells(Total_rows_Pick + h, 2) = Application.WorksheetFunction.Index(Worksheets("JO (SunGleam)").Range("F2:F" & Total_rows_JOSgleam), Application.WorksheetFunction.Match(Worksheets("Help Worksheet").Cells(q, 2), Worksheets("JO (Sungleam)").Range("A2:A" & Total_rows_JOSgleam), 0))
                    Worksheets("Pick-ups").Cells(Total_rows_Pick + h, 3) = Worksheets("Help Worksheet").Cells(q, 5)
                    Worksheets("Pick-ups").Cells(Total_rows_Pick + h, 4) = Application.WorksheetFunction.Index(Worksheets("JO (SunGleam)").Range("B2:B" & Total_rows_JOSgleam), Application.WorksheetFunction.Match(Worksheets("Help Worksheet").Cells(q, 2), Worksheets("JO (Sungleam)").Range("A2:A" & Total_rows_JOSgleam), 0))
                    Worksheets("Pick-ups").Cells(Total_rows_Pick + h, 5) = Worksheets("Help Worksheet").Cells(q, 1)
                    h = h + 1
                End If
            Next q
            Worksheets("Help Worksheet").Range("A2:E" & Total_rows_Help).Clear
        End If
    ElseIf IsError(Application.Match(Worksheets("Non-hourly Input").Cells(i, 5), Worksheets("JO (DR)").Range("B2:B" & Total_rows_JODR), 0)) = False And Worksheets("Non-hourly Input").Cells(i, 6) = "SUNGLEAM" Then
        JO_id(i) = Application.WorksheetFunction.Index(Worksheets("JO (DR)").Range("A2:A" & Total_rows_JOSgleam), Application.WorksheetFunction.Match(Worksheets("Non-hourly Input").Cells(i, 5), Worksheets("JO (DR)").Range("B2:B" & Total_rows_JODR), 0))
        Set filterRange = Worksheets("JO_Pickups (DR)").Range("$A$1:$E$" & Total_rows_JOPickDR) 'filter for less computations
        filterRange.AutoFilter Field:=2, Criteria1:=JO_id(i)
        On Error Resume Next
        Set filteredRange = Intersect(filterRange, filterRange.Offset(1, 0)).SpecialCells(xlCellTypeVisible) 'remove headers
        On Error GoTo 0
        If Not filteredRange Is Nothing Then
            For Each Area In filteredRange.Areas
                Worksheets("JO_Pickups (DR)").Range(Area.Address).Copy _
                Destination:=Worksheets("Help Worksheet").Cells(2, 1)
            Next Area
            Total_rows_Help = Worksheets("Help Worksheet").Range("A" & Rows.count).End(xlUp).Row
            'Filter Pick-up Worksheet to only display the JO's related to the Non-hourly Input
            Set filterRangePU = Worksheets("Pick-ups").Range("$A$1:$E$" & Total_rows_Pick) 'filter for less computations
            filterRangePU.AutoFilter Field:=4, Criteria1:=Worksheets("Non-hourly Input").Cells(i, 5)
            On Error Resume Next
            Set filteredRangePU = Intersect(filterRangePU, filterRangePU.Offset(1, 0)).SpecialCells(xlCellTypeVisible) 'remove headers
            On Error GoTo 0
            If Not filteredRangePU Is Nothing Then
                For Each AreaPU In filteredRangePU.AreasPU
                    Worksheets("Pick-ups").Range(Area.Address).Copy _
                    Destination:=Worksheets("Help WorksheetPU").Cells(2, 1)
                Next AreaPU
                Total_rows_HelpPU = Worksheets("Help WorksheetPU").Range("A" & Rows.count).End(xlUp).Row
                ReDim z(2 To Total_rows_Help, 2 To Total_rows_NHI)
                For q = 2 To Total_rows_Help
                    For j = 2 To Total_rows_HelpPU
                        If Worksheets("Help WorksheetPU").Cells(j, 5) = Worksheets("Help Worksheet").Cells(q, 1) Then
                            z(q, i) = 1
                        End If
                    Next j
                Next q
                Worksheets("Help WorksheetPU").Range("A2:E" & Total_rows_HelpPU).Clear
            End If
            For q = 2 To Total_rows_Help
                If z(q, i) <> 1 Then
                    Worksheets("Pick-ups").Cells(Total_rows_Pick + h, 1) = Format(Worksheets("Help Worksheet").Cells(q, 3), "short date")
                    Worksheets("Pick-ups").Cells(Total_rows_Pick + h, 2) = Application.WorksheetFunction.Index(Worksheets("JO (DR)").Range("F2:F" & Total_rows_JODR), Application.WorksheetFunction.Match(Worksheets("Help Worksheet").Cells(q, 2), Worksheets("JO (DR)").Range("A2:A" & Total_rows_JODR), 0))
                    Worksheets("Pick-ups").Cells(Total_rows_Pick + h, 3) = Worksheets("Help Worksheet").Cells(q, 5)
                    Worksheets("Pick-ups").Cells(Total_rows_Pick + h, 4) = Application.WorksheetFunction.Index(Worksheets("JO (DR)").Range("B2:B" & Total_rows_JODR), Application.WorksheetFunction.Match(Worksheets("Help Worksheet").Cells(q, 2), Worksheets("JO (DR)").Range("A2:A" & Total_rows_JODR), 0))
                    Worksheets("Pick-ups").Cells(Total_rows_Pick + h, 5) = Worksheets("Help Worksheet").Cells(q, 1)
                    h = h + 1
                End If
            Next q
            Worksheets("Help Worksheet").Range("A2:E" & Total_rows_Help).Clear
        End If
    ElseIf IsError(Application.Match(Worksheets("Non-hourly Input").Cells(i, 5), Worksheets("JO (FineWorks)").Range("B2:B" & Total_rows_JOFineWorks), 0)) = False And Worksheets("Non-hourly Input").Cells(i, 6) = "FINEWORKS" Then
        JO_id(i) = Application.WorksheetFunction.Index(Worksheets("JO (FineWorks)").Range("A2:A" & Total_rows_JOFineWorks), Application.WorksheetFunction.Match(Worksheets("Non-hourly Input").Cells(i, 5), Worksheets("JO (FineWorks)").Range("B2:B" & Total_rows_JOFineWorks), 0))
        Set filterRange = Worksheets("JO_Pickups (FineWorks)").Range("$A$1:$E$" & Total_rows_JOPickFineWorks) 'filter for less computations
        filterRange.AutoFilter Field:=2, Criteria1:=JO_id(i)
        On Error Resume Next
        Set filteredRange = Intersect(filterRange, filterRange.Offset(1, 0)).SpecialCells(xlCellTypeVisible) 'remove headers
        On Error GoTo 0
        If Not filteredRange Is Nothing Then
            For Each Area In filteredRange.Areas
                Worksheets("JO_Pickups (FineWorks)").Range(Area.Address).Copy _
                Destination:=Worksheets("Help Worksheet").Cells(2, 1)
            Next Area
            Total_rows_Help = Worksheets("Help Worksheet").Range("A" & Rows.count).End(xlUp).Row
            'Filter Pick-up Worksheet to only display the JO's related to the Non-hourly Input
            Set filterRangePU = Worksheets("Pick-ups").Range("$A$1:$E$" & Total_rows_Pick) 'filter for less computations
            filterRangePU.AutoFilter Field:=4, Criteria1:=Worksheets("Non-hourly Input").Cells(i, 5)
            On Error Resume Next
            Set filteredRangePU = Intersect(filterRangePU, filterRangePU.Offset(1, 0)).SpecialCells(xlCellTypeVisible) 'remove headers
            On Error GoTo 0
            If Not filteredRangePU Is Nothing Then
                For Each AreaPU In filteredRangePU.AreasPU
                    Worksheets("Pick-ups").Range(Area.Address).Copy _
                    Destination:=Worksheets("Help WorksheetPU").Cells(2, 1)
                Next AreaPU
                Total_rows_HelpPU = Worksheets("Help WorksheetPU").Range("A" & Rows.count).End(xlUp).Row
                ReDim z(2 To Total_rows_Help, 2 To Total_rows_NHI)
                For q = 2 To Total_rows_Help
                    For j = 2 To Total_rows_HelpPU
                        If Worksheets("Help WorksheetPU").Cells(j, 5) = Worksheets("Help Worksheet").Cells(q, 1) Then
                            z(q, i) = 1
                        End If
                    Next j
                Next q
                Worksheets("Help WorksheetPU").Range("A2:E" & Total_rows_HelpPU).Clear
            End If
            For q = 2 To Total_rows_Help
                If z(q, i) <> 1 Then
                    Worksheets("Pick-ups").Cells(Total_rows_Pick + h, 1) = Format(Worksheets("Help Worksheet").Cells(q, 3), "short date")
                    Worksheets("Pick-ups").Cells(Total_rows_Pick + h, 2) = Application.WorksheetFunction.Index(Worksheets("JO (FineWorks)").Range("F2:F" & Total_rows_JOFineWorks), Application.WorksheetFunction.Match(Worksheets("Help Worksheet").Cells(q, 2), Worksheets("JO (FineWorks)").Range("A2:A" & Total_rows_JOFineWorks), 0))
                    Worksheets("Pick-ups").Cells(Total_rows_Pick + h, 3) = Worksheets("Help Worksheet").Cells(q, 5)
                    Worksheets("Pick-ups").Cells(Total_rows_Pick + h, 4) = Application.WorksheetFunction.Index(Worksheets("JO (FineWorks)").Range("B2:B" & Total_rows_JOFineWorks), Application.WorksheetFunction.Match(Worksheets("Help Worksheet").Cells(q, 2), Worksheets("JO (FineWorks)").Range("A2:A" & Total_rows_JOFineWorks), 0))
                    Worksheets("Pick-ups").Cells(Total_rows_Pick + h, 5) = Worksheets("Help Worksheet").Cells(q, 1)
                    h = h + 1
                End If
            Next q
            Worksheets("Help Worksheet").Range("A2:E" & Total_rows_Help).Clear
        End If
    End If
Next i

1 个答案:

答案 0 :(得分：1)

一般来说，On Error Resume Next是一种不好的做法，尽量避免使用它。一开始就很难，经过一两天就很容易。在你的代码中，你有这样的东西（不久写）：

Public Sub TestMe()

    Dim someValue As Range

    On Error Resume Next
        'this is an error
        'but we have On Error Resume Next
    Set someValue = Cells(0, 0)

    On Error GoTo 0

    If someValue Is Not Nothing Then
        Debug.Print someValue.Address
    End If

End Sub

如您所见，someValue是错误的，因此在On Error GoTo 0之后，它会在If someValue is Not Nothing上抛出错误。

在上面的代码中，

Set filteredRange = Intersect(filterRange, filterRange.Offset(1, 0)).SpecialCells(xlCellT
如果相交为Nothing，

会自行抛出错误，因此无法分配任何＆＃34;特殊＆＃34;细胞（可见或不可见）

这是一种解决方法：

Set filteredRange = Intersect(filterRange, filterRange.Offset(1, 0))
If Not filteredRange Is Nothing Then
    Set filteredRange = filteredRange.SpecialCells(xlCellTypeVisible)

另请考虑将filteredRangePU声明为Range，而不是Variant。 Range是Object，Variant是数据类型。

相关问题
最新问题