Makro optimieren.
09.09.2023 14:38:11
Christian
ich versuche seit neuestem ein wenig mir VBA beizubringen und habe mir das unten stehende Makro zusammengebaut, mithilfe von Google, Recorder aber auch diesem Forum.
Soviel soll es eigentlich gar nicht machen, ich habe eine intelligente Tabelle, in dieser soll es eigentlich nur 4 Formeln berechnen und die Tabelle neu sortieren.
Aber irgendwie kommt es mir so vor, sagt jedenfalls mein bauchgefühl dass ich es mir gerade im Bereich des Sortierens viel zu umständlich gemacht habe und es würde mich freuen wenn sich jemand das ganze mal anschaut, ob sich das noch optimieren lässt.
Zwei Infos noch.
1. Die beiden NumberFormats in Spalte B habe ich gemacht, damit die Texte so übernommen werden wie sind und nicht z.b. aus 12/12/12 das Datum 12.12.2012 gemacht wird.
2. Wenn ihr euch jetzt die Frage stellt, warum ich überhaupt Formeln per Makro berechne und nicht direkt. Wegen der Berechnungszeit, jedesmal bei jeder Änderung an der Tabelle 5 Sekunden warten bis alle Formeln berechnet sind. Das Makro berechnet sie auf Wunsch und sonst nicht. Ich möchte das auch so beibehalten dass sie per Makro berechnet werden und nicht auf deaktivierung der Formelberechnung in den Excel Optionen ausweichen.
Danke
Christian
PS: Das Makro funktioniert wie es soll, es geht mir nur um Optimierung, nicht um Fehlersuche.
Private Sub Liste()
Dim loLetzte As Long
Application.ScreenUpdating = False
With Worksheets("Liste").ListObjects(1).DataBodyRange
With .Columns(2)
.NumberFormat = "General"
.FormulaLocal = "=XVERWEIS(A2;Filme!B:B;Filme!C:C;"""";0;1)"
.NumberFormat = "@"
.Formula = .Value2
End With
With .Columns(3)
.FormulaLocal = "=XVERWEIS(A2;Filme!B:B;Filme!E:E;"""";0;1)"
.Formula = .Value2
End With
With .Columns(5)
.FormulaLocal = "=XVERWEIS(D2;Leute!B:B;Leute!D:D;"""";0;1)"
.Formula = .Value2
End With
With .Columns(6)
.FormulaLocal = "=WENN(XVERWEIS(D2;Leute!B:B;Leute!C:C;"""";0;1)="""";"""";XVERWEIS(D2;Leute!B:B;Leute!C:C;"""";0;1))"
.Formula = .Value2
End With
End With
With Worksheets("Liste")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("C2:C" & loLetzte), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=.Range("F2:F" & loLetzte), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A2:F" & loLetzte)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub