VBA索引超出范围错误,但未调试

时间:2018-11-25 21:13:45

标签: excel vba

我有一些代码可以从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

2 个答案:

答案 0 :(得分:4)

这是known Excel bug

一种解决方法是选择足够远的单元格,例如在访问pivot_ui()集合之前,右下角:

HPageBreaks

答案 1 :(得分:0)

这是它崩溃的地方:

lastBreak = f.HPageBreaks(f.HPageBreaks.Count).Location.Row

但是只有在indexMain = 58时才这样做

您的第一个do循环在此行之后直接开始:

    Set artistNameCell = Sheets("Was").Cells(indexMain, 1)

输入:

    If indexMain = 58 Then Stop

这会将代码置于调试模式,然后与F8逐行进行操作,您将看到它崩溃。

如果这不能给您足够的指导以找到问题回发,我将进一步研究您的代码。