エラー「定義されたアプリケーションまたはオブジェクト定義のエラー」マクロ

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

あなたは「ARENので、あなたはあなたのエラーを取得しています最大21回実行される前にループの終了条件を満たす（その後、Excelシートの行数がオーバーフローします）。あなたは適切にダブルス行はあなたがするたびに対処しようとしているカウント... 変数はないオーバーフローが、このコード行を行うようlastRowが...、Longとして

lastRow = lastRow + lastRow 

を設定していますループを介して。アプリケーションのエラーは、最大1048576より大きい行のセルにアクセスしようとすると発生します。したがって、lastRowが1で始まる場合、それは1048576よりも前に21倍になります。 1行、それはずっと速くなります。

私はずっと、さらにそれよりも、あなたのコードを検討していないが、あなたはおそらくちょうどループ内で別の行カウンタを使用する必要があります。

未テスト： J = 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