如何解决VBA运行时错误9（下标越界）并让代码继续执行？

问题说明 #

运行以下VBA代码时，在Pdiv = ActiveSheet.HPageBreaks(PgCt).Location.Row行触发Run Time Error 9 - 下标越界，添加错误处理后仍无法正常执行：

''''''''''''''''''''''
ActiveWindow.View = xlNormalView
ActiveSheet.Cells.Pagebreak = xlPageBreakNone
Application.ScreenUpdating = True

Dim Pdiv, PgCt, Pgs
PgCt = 1
Pgs = ActiveSheet.HPageBreaks.Count
Do
If Pgs = 0 Then
    Exit Do
End If

On Error Resume Next
    Cells.AutoFilter
On Error GoTo 0

Pdiv = ActiveSheet.HPageBreaks(PgCt).Location.Row



If Not IsEmpty(Range("B" & Pdiv).Value) Then
'Cell is not empty therefore find the first occurrence of blank in Col B above this row
    Do
      'Loopback until there is an empty cell in Col B
        Pdiv = Pdiv - 1
    Loop Until IsEmpty(Range("B" & Pdiv))
'Set the new Page break above the empty cell
    Range("B" & Pdiv + 1).Select
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
End If
PgCt = PgCt + 1
Pgs = ActiveSheet.HPageBreaks.Count
Loop Until PgCt > ActiveSheet.HPageBreaks.Count

错误原因 #

1. 循环逻辑缺陷：每次添加新分页符后，HPageBreaks.Count会动态增加，但PgCt的递增逻辑未适配集合索引的动态变化，导致后续访问HPageBreaks(PgCt)时超出有效范围。
2. 缺乏边界判断：未在访问HPageBreaks(PgCt)前验证PgCt是否在1到HPageBreaks.Count之间，索引越界直接触发错误。
3. 细节错误：原代码中Cells.Pagebreak存在拼写错误（应为PageBreak），且Application.ScreenUpdating = True会拖慢执行效率，也未在代码结束时恢复默认设置。

修复后的代码 #

Sub AdjustPageBreaks()
    Dim ws As Worksheet
    Dim hBreak As HPageBreak
    Dim Pdiv As Long
    Dim originalScreenUpdating As Boolean
    
    ' 初始化环境与工作表对象
    Set ws = ActiveSheet
    originalScreenUpdating = Application.ScreenUpdating
    Application.ScreenUpdating = False
    ActiveWindow.View = xlNormalView
    ws.Cells.PageBreak = xlPageBreakNone ' 修正拼写错误
    
    ' 关闭自动筛选
    On Error Resume Next
    ws.Cells.AutoFilter
    On Error GoTo 0
    
    ' 遍历所有分页符，避免下标索引问题
    For Each hBreak In ws.HPageBreaks
        Pdiv = hBreak.Location.Row
        
        ' 调整分页符到B列空白行的下一行
        If Not IsEmpty(ws.Range("B" & Pdiv).Value) Then
            ' 向上查找B列第一个空白行，防止行号越界
            Do While Not IsEmpty(ws.Range("B" & Pdiv).Value) And Pdiv > 1
                Pdiv = Pdiv - 1
            Loop
            ' 添加新分页符
            ws.HPageBreaks.Add Before:=ws.Range("B" & Pdiv + 1)
        End If
    Next hBreak
    
    ' 恢复原始环境设置
    Application.ScreenUpdating = originalScreenUpdating
End Sub

关键优化点 #

• 使用For Each遍历HPageBreaks集合，彻底规避下标越界问题，无需手动管理索引变量。
• 修正原代码的拼写错误，确保分页符清除逻辑生效。
• 保存并恢复ScreenUpdating状态，提升执行效率的同时不影响后续操作。
• 增加Pdiv > 1的判断，防止循环时行号越界到非有效范围。
• 移除冗余的循环变量，简化代码逻辑。

内容的提问来源于stack exchange，提问作者GLB