For - Next - Abfrage verbessern | HERBERS Excel Forum

Hallo zusammen,
zwei Fragen habe ich:
1. Wie kann ich bei dieser For-Next-Abfrage die Zeile:
For lZeile_I = 4 To 2000 so ändern, dass automatisch die letzte Zeile erkannt wird.


Sub Eintragen_Test()
Dim lZeile_I  As Long
' Übertrag der Formeln von Zelle J3:L3 bis letzte ausgefüllte Zelle der Spalte I
Application.ScreenUpdating = False
Sheets("Auswertung").Select
With ThisWorkbook.Worksheets("Auswertung")
For lZeile_I = 4 To 2000
If Trim(.Range("I4" & lZeile_I).Value)  "" Then
.Range("J3:L3").Copy
.Range("J" & lZeile_I).PasteSpecial Paste:=xlPasteFormulas
End If
Next lZeile_I
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

2. Frage
Durch die Formeln, die von J3:L3 dort hineinkopiert werden, wird die Datei sehr langsam. Jedes Mal, wenn ich dann einen anderen Eintrag tätige, wird neu berechnet.
Da ich diese Formeln nur einmal zur Berechnung benötige, habe ich die Reihen J4 : L2000 kopiert und als Wert wieder eingefügt (per VBA).
Kann man diesen Befehl direkt in den obigen Code einbinden?
Über eine Antwort würde ich mich sehr freuen.
Gruß und schon einmal Danke
Michael

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Eintragen_Test() Dim lZeile_I As Long ' Übertrag der Formeln von Zelle J3:L3 bis letzte ausgefüllte Zelle der Spalte I Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Sheets("Auswertung").Select With ThisWorkbook.Worksheets("Auswertung") For lZeile_I = 4 To .Cells(.Rows.Count, 9).End(xlUp).Row If Trim(.Range("I4" & lZeile_I).Value) "" Then .Range("J3:L3").Copy .Range("J" & lZeile_I).PasteSpecial Paste:=xlPasteFormulas End If Next lZeile_I End With Application.CutCopyMode = False Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub

Sub Eintragen() With Sheets("Auswertung") .Range("J3:L3").Copy .Range(.Cells(4, 9), .Cells(Rows.Count, 9).End(xlUp)).Offset(, 1) .PasteSpecial xlPasteValues End With Application.CutCopyMode = False End Sub

Sub Eintragen_2() With Sheets("Auswertung") 'letzte Zelle in Spalte I ermitteln lz = .Range("I" & .Cells.Rows.Count).End(xlUp).Row '1. Kopie Funktion: Formeln einfügen .Range("J3:L3").Copy .Range("J4:J" & lz) '2. Kopie Funktion: Werte einfügen .Range("J4:L" & lz).Copy .Range("J4:L" & lz).PasteSpecial xlPasteValues End With Application.CutCopyMode = False End Sub

Beliebteste Forumthreads (12 Monate)

For - Next - Abfrage verbessern

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread