Hata "Uygulama tanımlı veya nesne hata tanımlanan" Excel'de

Question

Bu kod, sonra iki kez döngüler bir hata ile durur makro "Uygulama tanımlı veya nesne tanımlı hata"

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

sen 'değiller çünkü sizin hata alıyorsanız t Döngü için çıkış koşulunu en fazla 21 kez çalıştırmadan önce (ve sonra bir Excel sayfasındaki satır sayısını aşan). değişken değil taşması, ama bu kod satırı yapar böylece düzgün ...,

lastRow = lastRow + lastRow 

... çiftler bir Long olarak lastRow set satır, her zaman tespit etmeye çalıştığı sayısı var döngü boyunca. En fazla 1048576'dan daha yüksek bir satırda bir hücreye erişmeye çalıştığınızda uygulama hatası oluşur. Yani, bir sonRow ile başlarsanız, 1048576'dan daha önce 21 kez iki katına çıkar. Daha fazla ile başlarsanız 1 satır, çok daha hızlı gidiyor.

ben cok daha ileri kodunuzu muayene değil, ama muhtemelen sadece döngü içinde farklı bir satır sayacı kullanmak gerekir:

Untested:

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