Question

此代码循环两次，然后因“应用程序已定义或对象定义错误”

错误而停止

Sub addsheet()
Dim Copyrange As String
Dim Copyrange2 As String
Dim lastRow As Long
lastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
MsgBox lastRow
Dim newsheet
Set newsheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
newsheet.Name = "Consol"
Startrow = 1
Do While Not IsEmpty(Worksheets("Sheet1").Range("E1").Value)
 For i = Startrow To lastRow
        For j = 1 To 1
            Worksheets("Consol").Cells(i, j) = Worksheets("Sheet1").Range("E1").Value
        Next j
        Next i

    Let Copyrange = "B" & Startrow & ":" & "F" & lastRow
     Let Copyrange2 = "A1" & ":" & "E" & lastRow
     Worksheets("Consol").Range(Copyrange).Value = Worksheets("Sheet1").Range(Copyrange2).Value
     Columns("E").Delete
     Startrow = Startrow + lastRow
     lastRow = lastRow + lastRow
Loop
End Sub

Answer 1

您收到错误的原因是您在执行最多21次之前未满足循环的退出条件（并随后溢出Excel工作表中的行数）。您已将lastRow设置为Long，因此变量不会溢出，但这行代码...

lastRow = lastRow + lastRow

... 加倍每次循环时尝试解决的行数。当您尝试访问高于最大值1048576的行中的单元格时，会发生应用程序错误。因此，如果以lastRow为1开始，它将在它高于1048576之前加倍21次。如果您从超过1048576开始。 1行，它会更快。

我没有进一步检查你的代码，但你可能只需要在循环中使用不同的行计数器：

<强>未测试

Startrow = 1
Dim currentEnd As Long
currentEnd = lastRow
Do While Not IsEmpty(Worksheets("Sheet1").Range("E1").Value)
    For i = Startrow To currentEnd
        Worksheets("Consol").Cells(i, 1) = Worksheets("Sheet1").Range("E1").Value
    Next i

    Copyrange = "B" & Startrow & ":" & "F" & lastRow
    Copyrange2 = "A1" & ":" & "E" & lastRow
    Worksheets("Consol").Range(Copyrange).Value = Worksheets("Sheet1").Range(Copyrange2).Value
    Columns("E").Delete
    lastRow = currentEnd + lastRow
    Startrow = lastRow
Loop

Excel宏中的“应用程序定义或对象定义的错误”错误

1 个答案: