VBA error: Why does my code keep jumping back lines?
VBA error: Why does my code keep jumping back lines?
对于代码转储,我深表歉意,但经过两天的调试,我想我开始失去它了,我变得绝望了。我开发了如下所示的代码
intColumnCount = wsStaff.Cells(1, Columns.Count).End(xlToLeft).Column
intColumnLoop = 2
intStaffCount = 0
wsDisplay.Range("A2").EntireRow.UnMerge
wsDisplay.Range("A2").EntireRow.Value = ""
Do
intRowCount = wsStaff.Cells(Rows.Count, intColumnLoop).End(xlUp).Row
intRowLoop = 2
Do
If IsEmpty(wsStaff.Cells(intRowLoop, intColumnLoop)) And intRowLoop <> 2 Then
wsStaff.Range(wsStaff.Cells(intRowLoop, intColumnLoop).Address).Delete Shift:=xlUp
intRowCount = wsStaff.Cells(Rows.Count, intColumnLoop).End(xlUp).Row
Else
intStaffCount = intStaffCount + 1
If wsDisplay.Cells(1, intStaffCount + 2).Value <> wsStaff.Cells(intRowLoop, intColumnLoop).Value And wsDisplay.Cells(1, intStaffCount + 2).Value <> wsStaff.Cells(intRowLoop + 1, intColumnLoop).Value And wsDisplay.Cells(1, intStaffCount + 2).Value <> wsStaff.Cells(2, intColumnLoop + 1).Value And wsDisplay.Cells(1, intStaffCount + 2).Value <> "" Then
wsDisplay.Range(wsDisplay.Cells(1, intStaffCount + 2).Address).EntireColumn.Delete Shift:=xlToLeft
intRowCount = wsStaff.Cells(Rows.Count, intColumnLoop).End(xlUp).Row
intStaffCount = intStaffCount - 1
ElseIf wsDisplay.Cells(1, intStaffCount + 2).Value = wsStaff.Cells(intRowLoop + 1, intColumnLoop).Value Or wsDisplay.Cells(1, intStaffCount + 2).Value = wsStaff.Cells(2, intColumnLoop + 1).Value Or wsDisplay.Cells(1, intStaffCount + 2).Value = "" Then
wsDisplay.Range(wsDisplay.Cells(1, intStaffCount + 2).Address).EntireColumn.Insert Shift:=xlToRight
wsDisplay.Cells(1, intStaffCount + 2).Value = wsStaff.Cells(intRowLoop, intColumnLoop).Value
intRowLoop = intRowLoop + 1
Else
intRowLoop = intRowLoop + 1
End If
If wsDisplay.Cells(1, intStaffCount + 2).Value = wsDisplay.Cells(1, intStaffCount + 1).Value Then
wsDisplay.Range(wsDisplay.Cells(1, intStaffCount + 2).Address).EntireColumn.Delete Shift:=xlToLeft
intRowCount = wsStaff.Cells(Rows.Count, intColumnLoop).End(xlUp).Row
intStaffCount = intStaffCount - 1
End If
wsDisplay.Cells(1, intStaffCount + 2).Interior.Color = RGB(255 - (0.1 * (255 - intColourPalette(intColumnLoop Mod 6 + 1, 1))), 255 - (0.1 * (255 - intColourPalette(intColumnLoop Mod 6 + 1, 2))), 255 - (0.1 * (255 - intColourPalette(intColumnLoop Mod 6 + 1, 3))))
End If
Loop While Not intRowLoop > intRowCount
wsDisplay.Range(wsDisplay.Cells(2, 4 + intStaffCount - intRowCount).Address, wsDisplay.Cells(2, 2 + intStaffCount).Address).Merge
wsDisplay.Range(wsDisplay.Cells(2, 4 + intStaffCount - intRowCount).Address).Interior.Color = RGB(intColourPalette(intColumnLoop Mod 6 + 1, 1), intColourPalette(intColumnLoop Mod 6 + 1, 2), intColourPalette(intColumnLoop Mod 6 + 1, 3))
wsDisplay.Cells(2, 4 + intStaffCount - intRowCount).Value = wsStaff.Cells(1, intColumnLoop).Value
wsDisplay.Cells(2, 4 + intStaffCount - intRowCount).Font.Bold = True
wsDisplay.Cells(2, 4 + intStaffCount - intRowCount).Font.Color = RGB(255, 255, 255)
intColumnLoop = intColumnLoop + 1
Loop While Not intColumnLoop > intColumnCount
wsDisplay.Cells(1, 1).EntireRow.Orientation = -45
wsDisplay.Cells(1, 1).EntireRow.HorizontalAlignment = xlRight
wsDisplay.Range(wsDisplay.Cells(1, 3), wsDisplay.Cells(2, intStaffCount + 2)).Borders.LineStyle = xlContinuous
intDisplayRowLength = wsDisplay.Cells(1, Columns.Count).End(xlToLeft).Column
intEraser = intStaffCount + 3
wsDisplay.Range(wsDisplay.Cells(1, intEraser), wsDisplay.Cells(1, intDisplayRowLength)).EntireColumn.Delete Shift:=xlToLeft
End Sub
所以我有两个问题,都涉及代码跳回行和重新执行代码。我通过在不同变量条件下几乎所有代码都在断点上单步执行代码数百次来解决这个问题。
每当重新定义 intRowCount 时,代码经常会跳回开头,此错误对输出无害,但会显着增加计算时间。我知道这可能内置于 Do 循环中,因此很不方便,但不是最大的问题。
最大的问题是倒数第二行,在删除所有不需要的列后,代码会跳回到最后一个end if语句,它在嵌套的do循环中。我不知道它为什么跳回,最重要的是,intRowCount、intRowLoop、intColumnCount 和 intColumnLoop 变量似乎发生了变化以允许重复代码循环。
这是灾难性的原因是因为 intStaffCount 没有改变,这意味着数据被添加了两次。
如果有人能提供任何见解,将不胜感激。
编辑:跳转到代码中添加新项目的位置,并选择在到达倒数第二行时无限跳转。
编辑 2:实际上是到达 End Sub 行,只是没有结束
编辑 3:在显示的代码外部找到解决方案,必须在调用 sub 之前禁用事件并在
之后重新启用
问题不存在于我的模块代码中,而是存在于事件代码中,通过在调用程序时禁用事件,问题得以解决。感谢 barrowc 的解决方案。
对于代码转储,我深表歉意,但经过两天的调试,我想我开始失去它了,我变得绝望了。我开发了如下所示的代码
intColumnCount = wsStaff.Cells(1, Columns.Count).End(xlToLeft).Column
intColumnLoop = 2
intStaffCount = 0
wsDisplay.Range("A2").EntireRow.UnMerge
wsDisplay.Range("A2").EntireRow.Value = ""
Do
intRowCount = wsStaff.Cells(Rows.Count, intColumnLoop).End(xlUp).Row
intRowLoop = 2
Do
If IsEmpty(wsStaff.Cells(intRowLoop, intColumnLoop)) And intRowLoop <> 2 Then
wsStaff.Range(wsStaff.Cells(intRowLoop, intColumnLoop).Address).Delete Shift:=xlUp
intRowCount = wsStaff.Cells(Rows.Count, intColumnLoop).End(xlUp).Row
Else
intStaffCount = intStaffCount + 1
If wsDisplay.Cells(1, intStaffCount + 2).Value <> wsStaff.Cells(intRowLoop, intColumnLoop).Value And wsDisplay.Cells(1, intStaffCount + 2).Value <> wsStaff.Cells(intRowLoop + 1, intColumnLoop).Value And wsDisplay.Cells(1, intStaffCount + 2).Value <> wsStaff.Cells(2, intColumnLoop + 1).Value And wsDisplay.Cells(1, intStaffCount + 2).Value <> "" Then
wsDisplay.Range(wsDisplay.Cells(1, intStaffCount + 2).Address).EntireColumn.Delete Shift:=xlToLeft
intRowCount = wsStaff.Cells(Rows.Count, intColumnLoop).End(xlUp).Row
intStaffCount = intStaffCount - 1
ElseIf wsDisplay.Cells(1, intStaffCount + 2).Value = wsStaff.Cells(intRowLoop + 1, intColumnLoop).Value Or wsDisplay.Cells(1, intStaffCount + 2).Value = wsStaff.Cells(2, intColumnLoop + 1).Value Or wsDisplay.Cells(1, intStaffCount + 2).Value = "" Then
wsDisplay.Range(wsDisplay.Cells(1, intStaffCount + 2).Address).EntireColumn.Insert Shift:=xlToRight
wsDisplay.Cells(1, intStaffCount + 2).Value = wsStaff.Cells(intRowLoop, intColumnLoop).Value
intRowLoop = intRowLoop + 1
Else
intRowLoop = intRowLoop + 1
End If
If wsDisplay.Cells(1, intStaffCount + 2).Value = wsDisplay.Cells(1, intStaffCount + 1).Value Then
wsDisplay.Range(wsDisplay.Cells(1, intStaffCount + 2).Address).EntireColumn.Delete Shift:=xlToLeft
intRowCount = wsStaff.Cells(Rows.Count, intColumnLoop).End(xlUp).Row
intStaffCount = intStaffCount - 1
End If
wsDisplay.Cells(1, intStaffCount + 2).Interior.Color = RGB(255 - (0.1 * (255 - intColourPalette(intColumnLoop Mod 6 + 1, 1))), 255 - (0.1 * (255 - intColourPalette(intColumnLoop Mod 6 + 1, 2))), 255 - (0.1 * (255 - intColourPalette(intColumnLoop Mod 6 + 1, 3))))
End If
Loop While Not intRowLoop > intRowCount
wsDisplay.Range(wsDisplay.Cells(2, 4 + intStaffCount - intRowCount).Address, wsDisplay.Cells(2, 2 + intStaffCount).Address).Merge
wsDisplay.Range(wsDisplay.Cells(2, 4 + intStaffCount - intRowCount).Address).Interior.Color = RGB(intColourPalette(intColumnLoop Mod 6 + 1, 1), intColourPalette(intColumnLoop Mod 6 + 1, 2), intColourPalette(intColumnLoop Mod 6 + 1, 3))
wsDisplay.Cells(2, 4 + intStaffCount - intRowCount).Value = wsStaff.Cells(1, intColumnLoop).Value
wsDisplay.Cells(2, 4 + intStaffCount - intRowCount).Font.Bold = True
wsDisplay.Cells(2, 4 + intStaffCount - intRowCount).Font.Color = RGB(255, 255, 255)
intColumnLoop = intColumnLoop + 1
Loop While Not intColumnLoop > intColumnCount
wsDisplay.Cells(1, 1).EntireRow.Orientation = -45
wsDisplay.Cells(1, 1).EntireRow.HorizontalAlignment = xlRight
wsDisplay.Range(wsDisplay.Cells(1, 3), wsDisplay.Cells(2, intStaffCount + 2)).Borders.LineStyle = xlContinuous
intDisplayRowLength = wsDisplay.Cells(1, Columns.Count).End(xlToLeft).Column
intEraser = intStaffCount + 3
wsDisplay.Range(wsDisplay.Cells(1, intEraser), wsDisplay.Cells(1, intDisplayRowLength)).EntireColumn.Delete Shift:=xlToLeft
End Sub
所以我有两个问题,都涉及代码跳回行和重新执行代码。我通过在不同变量条件下几乎所有代码都在断点上单步执行代码数百次来解决这个问题。
每当重新定义 intRowCount 时,代码经常会跳回开头,此错误对输出无害,但会显着增加计算时间。我知道这可能内置于 Do 循环中,因此很不方便,但不是最大的问题。
最大的问题是倒数第二行,在删除所有不需要的列后,代码会跳回到最后一个end if语句,它在嵌套的do循环中。我不知道它为什么跳回,最重要的是,intRowCount、intRowLoop、intColumnCount 和 intColumnLoop 变量似乎发生了变化以允许重复代码循环。
这是灾难性的原因是因为 intStaffCount 没有改变,这意味着数据被添加了两次。
如果有人能提供任何见解,将不胜感激。
编辑:跳转到代码中添加新项目的位置,并选择在到达倒数第二行时无限跳转。
编辑 2:实际上是到达 End Sub 行,只是没有结束
编辑 3:在显示的代码外部找到解决方案,必须在调用 sub 之前禁用事件并在
之后重新启用问题不存在于我的模块代码中,而是存在于事件代码中,通过在调用程序时禁用事件,问题得以解决。感谢 barrowc 的解决方案。