Makro sehr langsam

Hallo,
ich habe hier ein Makro. Hintergrund ist eine Abfrage von Vergleichswerten und eine Rückgabe von Daten bei gleichem Wert. Das ganze geht über eine Loop Abfrage in zwei Excel Sheets die Zeilen durch. Ich weiß es ist wahrscheinlich nicht besonders "schön" programmiert, aber es funktioniert so weit. Nur ist es sehr langsam. Es werden zwischen 1000 und 2000 Zeilen abgefragt. Die Frage ist nun, ob es irgendwie zu beschleunigen ist?
Anbei die beiden Codes:

Sub Berechnen()
    Application.ScreenUpdating = False
    Sheets("Eingabe").Select
    Range("B8").Select
    Selection.End(xlDown).Select
        If ActiveCell = "" Or Range("B5") = "" Or Range("B3") = "" Then
        On Error GoTo Fehler
Fehler:
        MsgBox "Eingabewert fehlt!", vbExclamation
    Else
    ActiveCell.Offset(ColumnOffset:=2).Activate
    ActiveCell.FormulaR1C1 = "=RC[-2]/R5C2"
    ActiveCell.Select
    Selection.Copy
    Selection.End(xlUp).Select
    ActiveCell.Offset(RowOffset:=1).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    ActiveCell.Select
    Application.CutCopyMode = False
    End If
    'Application.Goto Reference:="Start"
    Range("A1").Select
    
  EndZeile = Range("B1048576").End(xlUp).Row
zeile = 10
Do
    If Cells(zeile, 2) > "" Then Cells(zeile, 3) = "=R[-1]C+60*R4C2"
    zeile = zeile + 1
Loop Until zeile > EndZeile
    
Call Sverweis
Sheets("Auswertung").Select
Application.ScreenUpdating = True
End Sub

________________________________________________________________________

Sub Sverweis()
Sheets("Berechnungen").Select
Range("C2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    
EndZeile = Range("A500000").End(xlUp).Row
zeile = 2
Do
    If Cells(zeile, 1) > "" Then Cells(zeile, 3) = "=VLOOKUP(RC[-2],Eingabe!C:C[1],2,FALSE)"
    zeile = zeile + 1
Loop Until zeile > EndZeile
EndZeile = Range("A500000").End(xlUp).Row
zeile = 2
Do
    If Cells(zeile, 1) > "" Then Cells(zeile, 4) = "=RC[-2]-RC[-1]"
    zeile = zeile + 1
Loop Until zeile > EndZeile
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

With Sheets("Berechnungen") with .Range("C2:D" & .Cells(.Rows.count, 1).End(xlup).Row) .Columns(1).FormulaR1C1 = "=IF(RC1="""","""",VLOOKUP(RC[-2],Eingabe!C:C[1],2,FALSE))" .Columns(2).FormulaR1C1 = "=IF(RC1="""","""",RC[-2]-RC[-1])" end with End with

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread