我有一些代码可以从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
答案 0 :(得分:4)
答案 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逐行进行操作,您将看到它崩溃。
如果这不能给您足够的指导以找到问题回发,我将进一步研究您的代码。