Question

我正在尝试从条件wb中按条件列表进行过滤，以用于Order wb。我使用checkEmpty范围来检查是否没有匹配的值，然后清除过滤器并从下一个条件开始。但是我的代码不起作用，并且错误是“ Range of object_worksheet”失败。我收到错误消息是因为即使没有匹配值（空范围），代码仍然跳到其他条件。这是我的代码：

Sub Order()

Dim start As Double
Dim strKeyWord As String
Dim myCount As Integer
Dim checkEmpty As Range
Dim lRow1 As Long

Dim wsOrder As Worksheet
Dim wsCondition As Worksheet
Dim wbOrder As Workbook
Dim wbCondition As Workbook

Dim OrderFile As String
Dim ConditionFile As String

'Open Order wb
OrderFile = Application.GetOpenFilename()
Set wbOrder = Workbooks.Open(OrderFile)
Set wsOrder = wbOrder.Worksheets(1)

'Open Condition wb
ConditionFile = Application.GetOpenFilename()
Set wbCondition = Workbooks.Open(ConditionFile)
Set wsCondition = wbCondition.Worksheets(1)

'using the CountA ws function (all non-blanks)
myCount = Application.CountA(wsCondition.Range("A:A")) - 1

start = 2

For I = 1 To myCount Step 1

    strKeyWord = wsCondition.Range("A" & start)
    wsOrder.Range("R:R").AutoFilter Field:=1, Criteria1:="=*" & strKeyWord & "*"

    'lRow1 = WorksheetFunction.Max(wsOrder.Range("I65536").End(xlUp).Row)
    Set checkEmpty = wsOrder.Range("I2:I100").SpecialCells(xlCellTypeVisible)

    If checkEmpty Is Nothing Then
        On Error Resume Next
        wsOrder.ShowAllData
        On Error GoTo 0
    Else
        wsOrder.Range("I2", Range("I" & Rows.Count).End(xlUp)).Copy
        With wsCondition
            .Cells(.Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial
        End With
    End If
    start = start + 1

Next I
End Sub

非常感谢您！

Answer 1

所以主要问题是您没有为Range("I" & Rows.Count).End(xlUp)指定工作表。

使用

wsOrder.Range("I2", Range("I" & wsOrder.Rows.Count).End(xlUp)).Copy

应该解决这个问题。

但是我也将更正For I循环，因为您从不使用I。但是您不需要start变量，可以使用I来代替，它也会自动递增。

'using the CountA ws function (all non-blanks)
myCount = Application.CountA(wsCondition.Range("A:A")) 'removed the -1

'remove start=2 and replace start with I

For I = 2 To myCount Step 1
    strKeyWord = wsCondition.Range("A" & I)
    wsOrder.Range("R:R").AutoFilter Field:=1, Criteria1:="=*" & strKeyWord & "*"

    'lRow1 = WorksheetFunction.Max(wsOrder.Range("I65536").End(xlUp).Row)
    Set checkEmpty = wsOrder.Range("I2:I100").SpecialCells(xlCellTypeVisible)

    If checkEmpty Is Nothing Then
        On Error Resume Next
        wsOrder.ShowAllData
        On Error GoTo 0
    Else
        wsOrder.Range("I2", Range("I" & Rows.Count).End(xlUp)).Copy
        With wsCondition
            .Cells(.Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial
        End With
    End If   
Next I

检查vba中是否有空Range

1 个答案: