Code optimieren bzw. beschleunigen
Charly
Könnte mir jemand helfen den folgenden Code zu verbessern bzw. zu beschleunigen?
Sub Act()
Dim lngStart, lngLast, i, z As Long
Dim rngZelle As Range
Application.ScreenUpdating = 0
lngStart = Sheets("Formular").Index + 1
lngLast = Sheets("LV").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("LV")
.Range("I1,K1,P1,M1:N1,H2:P2000").ClearContents
.Range("A1:N2000").Font.ColorIndex = xlAutomatic
.Range("A1:N2000").Interior.ColorIndex = xlNone
.Range("O2:P2000,P1").Font.Color = RGB(255, 255, 255)
'Werte ins LV eintragen
For i = lngStart To Sheets.Count
For z = 2 To lngLast
If .Cells(z, 1) = Sheets(i).Cells(9, 32) And Sheets(i).Cells(5, 33) = 1 Then _
.Cells(z, 8) = Sheets(i).Cells(23, 12)
If .Cells(z, 1) = Sheets(i).Cells(9, 32) And Sheets(i).Cells(5, 33) = 2 Then _
.Cells(z, 10) = Sheets(i).Cells(23, 12)
If .Cells(z, 1) = Sheets(i).Cells(9, 32) And Sheets(i).Cells(5, 33) = 3 Then _
.Cells(z, 12) = Sheets(i).Cells(23, 12)
Next z
Next i
'Formeln eintragen
'Summe LV"
.Cells(1, 7).FormulaLocal = "=SUMME(G2:G" & lngLast & ")"
'Nr. 1
.Range(.Cells(2, 9), .Cells(lngLast, 9)).FormulaLocal = "=$H2*$F2"
.Cells(1, 9).FormulaLocal = "=SUMME(I2:I" & lngLast & ")"
'Nr. 2
.Range(.Cells(2, 11), .Cells(lngLast, 11)).FormulaLocal = "=$J2*$F2"
.Cells(1, 11).FormulaLocal = "=SUMME(K2:K" & lngLast & ")"
'Nr. 3
.Range(.Cells(2, 13), .Cells(lngLast, 13)).FormulaLocal = "=$L2*$F2"
.Cells(1, 13).FormulaLocal = "=SUMME(M2:M" & lngLast & ")"
'Summe Betrag - Abgerechnet Nr.1 - Nr.2 - Nr.3
.Range(.Cells(2, 14), .Cells(lngLast, 14)).FormulaLocal = "=($I2+$K2+$M2)"
.Cells(1, 14).FormulaLocal = "=SUMME(N2:N" & lngLast & ")"
'Formel zum Filtern
.Range(.Cells(2, 15), .Cells(lngLast, 15)).FormulaLocal = _
"=WENN(($H2+$J2+$L2)=0;""Nicht"";WENN((I2+K2+M2)>G2;""Positiv"";WENN((I2+K2+M2)=G2;""Null" _
" _
;WENN((I2+K2+M2)0;($H2+$J2+$L2)= _
_
0);$G2;"""")"
.Cells(1, 16).FormulaLocal = "=SUMME(P2:P" & lngLast & ")"
'Formatieren
.Range("G1,N1").Interior.Color = RGB(200, 200, 200)
For i = 2 To lngLast
If .Range("O" & i) = "Positiv" Then .Range(.Cells(i, 1), .Cells(i, 14)).Interior. _
Color = RGB(200, 255, 200)
If .Range("O" & i) = "Negativ" Then .Range(.Cells(i, 1), .Cells(i, 14)).Interior. _
Color = RGB(255, 200, 200)
If .Range("O" & i) = "Null" Then .Range(.Cells(i, 1), .Cells(i, 14)).Font.Color = RGB( _
_
0, 0, 255)
If .Range("O" & i) = "Nicht" Then .Range(.Cells(i, 1), .Cells(i, 14)).Font.Color = _
RGB(0, 0, 0)
Next
'Formeln in Werte
.Range("A1:P" & lngLast).Value = .Range("A1:P" & lngLast).Value
End With
'Formular aktualisieren
With Sheets("Formular")
.Unprotect
.Cells(18, 38) = Sheets("LV").Range("G1") 'LV Summe
.Cells(20, 38) = Sheets("LV").Range("I1") 'Abger. Nr.1
.Cells(21, 38) = Sheets("LV").Range("K1") 'Abger. Nr.2
.Cells(22, 38) = Sheets("LV").Range("M1") 'Abger. Nr.3
.Cells(18, 39) = .Cells(20, 38) + .Cells(21, 38) + .Cells(22, 38) 'Summe Abgerechnet
.Cells(23, 38) = Sheets("LV").Range("P1") 'Summe nicht Abgerechnet
.Cells(24, 38) = Sheets("LV").Range("N1") + Sheets("LV").Range("P1") 'Summe Abgerechnet + _
_
Summe nicht Abgerechnet
'Formatierung Differenz
If .Range("AL19") 0 Then .Range("AL19:AM19").Interior.Color = RGB(150, 255, 180)
If .Range("AL19") = 0 Then .Range("AL19:A19").Interior.Color.Index = xlNone
.Protect
End With
End Sub