为什么在循环内索引范围时出现错误

Question

嗨，请有人告诉我这段代码有什么问题。 我正在计算某个范围内的空白单元格数量，并且不断因运行时错误而崩溃，在行溢出

blnkrowcount = WorksheetFunction.CountBlank(ws.Range("ay:hy"))

代码：

    Dim k As Long
    Dim y As Integer
    Dim blnkrowcount As Integer

    y = Lrow
    For k = Lrow To 1 Step -1
        blnkrowcount = WorksheetFunction.CountBlank(ws.Range("ay:hy"))
        If blnkrowcount <> 0 Then
            Sheets("Invoices").Select
            Rows(k).Select
            Selection.Delete Shift:=xlUp
        End If
        y = y - 1
    Next k
End Sub

your text

使用变量 y 设置范围（最初是 k 但不起作用，所以尝试创建一个新变量

还尝试了 & 并设置范围变量，但均未成功。

Answer 1

删除特定列中包含空白单元格的行

Sub DeleteBlankRows()
    
    ' Define constants.
    Const PROC_TITLE As String = "Delete Blank Rows"
    Const DISPLAY_MESSAGES As Boolean = True
    
    ' Reference the objects.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Sheets("Invoices")
    Dim rg As Range: Set rg = ws.UsedRange
    Dim ecrg As Range: Set ecrg = ws.Columns("AY:HY") ' columns to check
    Dim crg As Range: Set crg = Intersect(rg, ecrg)
    
    ' Validate columns.
    If crg Is Nothing Then
       If DISPLAY_MESSAGES Then
           MsgBox "All columns are out of bounds!", vbExclamation, PROC_TITLE
           Exit Sub
       End If
    End If
    
    ' Store the number of columns in a variable (if ALL CELLS)
    ' and validate columns again.
    Dim cCount As Long: cCount = crg.Columns.Count
    If cCount < ecrg.Columns.Count Then
        If DISPLAY_MESSAGES Then
            MsgBox "Some columns are out of bounds!", vbExclamation, PROC_TITLE
            Exit Sub
        End If
    End If
    
    Dim urg As Range, rrg As Range, r As Long, IsFirstFound As Boolean
    ' Combine rows to be deleted into a unioned range.
    For Each rrg In crg.Rows
        r = r + 1
        If Application.CountBlank(rrg) = cCount Then ' ALL CELLS are blank
        'If Application.CountBlank(rrg) > 0 Then ' ANY CELL is blank
            If IsFirstFound Then
                Set urg = Union(urg, rg.Rows(r))
            Else
                Set urg = rg.Rows(r)
                IsFirstFound = True
            End If
        End If
    Next rrg
    
    ' Delete blank rows (unioned range).
    If IsFirstFound Then urg.Delete Shift:=xlShiftUp
        
    ' Inform.
    If DISPLAY_MESSAGES Then
        If IsFirstFound Then
            MsgBox "Blank rows deleted.", vbInformation, PROC_TITLE
        Else
            MsgBox "No blank rows found!", vbExclamation, PROC_TITLE
        End If
    End If

End Sub