AW: VBA - Namen austauschen
11.05.2019 08:09:38
fcs
Hallo Fred,
eine Optimierung kann wie folgt ausssehen:
1. man kann die Formeln direkt in den gesamten Bereich eintragen ohne zusätzliches AutoFill.
2. Die berechneten Formelwerte muss man nicht Zelle für Zelle übertragen. man kann den kompletten Bereich als Werte eintragen. Alternativ könnte man den Bereich mit den Formeln im L:M kopieren und als Werte in F:G einfügen.
Eine Aufteilung auf 2 Makros ist hier auch nicht zweckmäßig, da die Berechnung der letzten Zeile in beiden Makros erfolgen muss.
Da du in weiteren Spalte viele Formeln hast sollte wie bei meinem Vorschlag zusätzlich vorübergend die Berechnung auf manuell gesetzt und die Bildschirmaktualisierung deaktiviert werden. Dadurch wird di Ausführung des Makros erheblich beschleunigt.
LG
Franz
Sub teil_1()
With ActiveSheet
lngLastRow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
With .Range("L2:M" & lngLastRow1)
.FormulaLocal = _
"=WENN(ISTFEHLER(SVERWEIS(F2;Kriterien!$A:$B;2;0));F2;SVERWEIS(F2;Kriterien!$A:$B;2;0))"
.Calculate
End With
End With
Call teil_2
End Sub
Sub teil_2()
Dim wksBlatt As Worksheet, lngLastRow2 As Long
Set wksBlatt = ActiveSheet
With wksBlatt
lngLastRow2 = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(2, 6), .Cells(lngLastRow2, 7)).Value = _
.Range(.Cells(2, 12), .Cells(lngLastRow2, 13)).Value
.Columns("L:M").Delete
End With
End Sub
Beide Makros zusammengefasst:
Sub teil_1_und_2()
With ActiveSheet
lngLastRow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
With .Range("L2:M" & lngLastRow1)
.FormulaLocal = _
"=WENN(ISTFEHLER(SVERWEIS(F2;Kriterien!$A:$B;2;0));F2;SVERWEIS(F2;Kriterien!$A:$B;2;0))"
.Calculate
End With
.Range(.Cells(2, 6), .Cells(lngLastRow1, 7)).Value = _
.Range(.Cells(2, 12), .Cells(lngLastRow1, 13)).Value
.Columns("L:M").Delete
End With
End Sub