excel - VBA索引超出范围错误，但不是在调试

Question

我有一些代码从 2 个不同的工作表中获取数据，并创建和输出工作表。问题是，如果在数据中创建了一个新页面，它必须做一些额外的信息，并改变分页符的位置。当我在调试事件的情况下运行代码以查看导致错误的代码行时，它工作得很好。

当我让它在没有调试的情况下运行时，它会给我一个索引超出范围的错误。

我已将 excel 表本身上传到 https://www.dropbox.com/s/pcl5zwuna8g7wrf/Test.xlsm?dl=0但我只是不明白为什么它会根据是否单步执行而导致不同的输出，因为它无论如何都是单线程的？

按下第四张纸上的按钮时会发生这种情况。

我将代码上传到了 pastebin:https://pastebin.com/rMwi7c7G

Public Function SeitenNr(rngZelle As Range) As Integer
  Dim wksHor As Integer, wksVert As Integer, SeiteNr As Integer
  Dim VertPb As Object, HortPb As Object
  Dim lngOrder As Long

  lngOrder = rngZelle.Parent.PageSetup.Order
  wksVert = rngZelle.Parent.VPageBreaks.Count + 1
  wksHor = rngZelle.Parent.HPageBreaks.Count + 1

  SeiteNr = 1
  For Each VertPb In rngZelle.Parent.VPageBreaks
    If VertPb.Location.Column > rngZelle.Column Then Exit For
    SeiteNr = SeiteNr + IIf(lngOrder = xlDownThenOver, wksHor, 1)
  Next VertPb
  For Each HortPb In rngZelle.Parent.HPageBreaks
    If HortPb.Location.Row > rngZelle.Row Then Exit For
    SeiteNr = SeiteNr + IIf(lngOrder = xlDownThenOver, 1, wksVert)
  Next HortPb
  SeitenNr = SeiteNr
End Function

Sub updateOutput()
    'Sheets("Print-Macro").UsedRange.ClearContents
    'Sheets("Print-Macro").Cells.UnMerge
    Application.DisplayAlerts = False
    Sheets("Print-Macro").Delete
    Application.DisplayAlerts = True
    Dim sheet As Worksheet
    Set sheet = Sheets.Add
    sheet.Name = "Print-Macro"

    Dim indexMain As Integer
    Dim currentIndex As Integer

    Dim artistName As String
    Dim artistNameLast As String
    Dim cellIndexOutput As Integer
    Dim birthdate As String
    Dim deathdate As String
    Dim originalPage As Integer
    Dim currentPage As Integer
    Dim latestPage As Integer
    Dim lastArtistPage As Integer
    Dim birthIndex As Integer
    Dim firstPageArtist As Integer

    indexMain = 2
    cellIndexOutput = 1
    Set f = ThisWorkbook.Worksheets("Print-Macro")

    Do
        Sheets("Print-Macro").Rows(cellIndexOutput).RowHeight = 15
        Set artistNameCell = Sheets("Was").Cells(indexMain, 1)
        If IsEmpty(artistNameCell.Value) Then
            Exit Do
        End If

        'Code only gets here if a valid entry is found. So create the output now
        artistName = artistNameCell.Value
        birthdate = ""
        deathdate = ""

        If artistNameLast <> artistName Then
            birthIndex = 2
            Do
                Dim tempName As String
                tempName = Sheets("Geboren").Cells(birthIndex, 1).Value
                If IsEmpty(Sheets("Geboren").Cells(birthIndex, 1).Value) Then
                    Exit Do
                End If

                If (tempName = artistName) Then
                    birthdate = Sheets("Geboren").Cells(birthIndex, 2).Value
                    deathdate = Sheets("Geboren").Cells(birthIndex, 3).Value
                End If
                birthIndex = birthIndex + 1
            Loop

            Sheets("Print-Macro").Range("A" & cellIndexOutput & ":" & "C" & cellIndexOutput).Merge
            Sheets("Print-Macro").Cells(cellIndexOutput, 1).Value = artistName & " (" & birthdate & "-" & deathdate & ")"
            Sheets("Print-Macro").Cells(cellIndexOutput, 1).Font.Underline = xlUnderlineStyleSingle
            lastArtistPage = Sheets("Print-Macro").HPageBreaks.Count
            firstPageArtist = cellIndexOutput
            cellIndexOutput = cellIndexOutput + 1
            Sheets("Print-Macro").Rows(cellIndexOutput).RowHeight = 15
        End If

        Sheets("Print-Macro").Rows(cellIndexOutput).RowHeight = 20

        Sheets("Print-Macro").Cells(cellIndexOutput, 2).Value = Sheets("Was").Cells(indexMain, 2).Value
        Sheets("Print-Macro").Cells(cellIndexOutput, 2).Font.Underline = xlUnderlineStyleNone

        Sheets("Print-Macro").Cells(cellIndexOutput, 3).Value = Sheets("Was").Cells(indexMain, 3).Value
        Sheets("Print-Macro").Cells(cellIndexOutput, 3).Font.Underline = xlUnderlineStyleNone

        cellIndexOutput = cellIndexOutput + 1
        Sheets("Print-Macro").Rows(cellIndexOutput).RowHeight = 15

        Sheets("Print-Macro").Cells(cellIndexOutput, 2).Value = Sheets("Was").Cells(indexMain, 4).Value
        Sheets("Print-Macro").Cells(cellIndexOutput, 2).Font.Underline = xlUnderlineStyleNone

        Sheets("Print-Macro").Cells(cellIndexOutput, 3).Value = Sheets("Was").Cells(indexMain, 5).Value
        Sheets("Print-Macro").Cells(cellIndexOutput, 3).Font.Underline = xlUnderlineStyleNone


        ' A page break happened in the last two lines it appears
        If lastArtistPage <> Sheets("Print-Macro").HPageBreaks.Count Then
            If cellIndexOutput = firstPageArtist + 2 Then
                f.Rows(firstPageArtist).PageBreak = xlPageBreakManual
            Else
                Set f = ThisWorkbook.Worksheets("Print-Macro")
                Dim lastBreak As Integer
                lastBreak = f.HPageBreaks(f.HPageBreaks.Count).Location.Row
                If lastBreak = cellIndexOutput Then
                    Sheets("Print-Macro").Range("A" & f.HPageBreaks(f.HPageBreaks.Count).Location.Row - 1).EntireRow.Insert
                    cellIndexOutput = cellIndexOutput + 1
                End If

                Sheets("Print-Macro").Range("A" & f.HPageBreaks(f.HPageBreaks.Count).Location.Row).EntireRow.Insert

                f.Rows(lastBreak).PageBreak = xlPageBreakManual

                Sheets("Print-Macro").Range("A" & lastBreak & ":" & "C" & lastBreak).Merge
                Sheets("Print-Macro").Range("A" & lastBreak & ":" & "C" & lastBreak).Value = "Noch " & artistName
                Sheets("Print-Macro").Range("A" & lastBreak & ":" & "C" & lastBreak).Font.Underline = xlUnderlineStyleSingle
                cellIndexOutput = cellIndexOutput + 1
            End If
        End If

        lastArtistPage = Sheets("Print-Macro").HPageBreaks.Count

        For i = 1 To f.HPageBreaks.Count
             Worksheets("Print-Macro").Cells(i, 4).Value = f.HPageBreaks(i).Location.Row
         Next

        latestPage = currentPage

        cellIndexOutput = cellIndexOutput + 1
        artistNameLast = artistName
        indexMain = indexMain + 1
    Loop
End Sub

Answer 1

这是 known Excel bug .

一种解决方法是选择一个足够远的单元格，例如右下角，在访问 HPageBreaks 之前收藏:

Dim previousActiveCell As Range
Set previousActiveCell = ActiveCell
f.Cells(f.Rows.Count, f.Columns.Count).Activate
Dim lastBreak As Integer
lastBreak = f.HPageBreaks(f.HPageBreaks.Count).Location.Row
previousActiveCell.Activate