檢查vba中是否有空Range

Question

我試圖按條件wb中的條件列表進行篩選，以用於訂單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