Hilfe bei MakroCode verkürzen!
30.06.2004 17:05:08
Lorenz
Die ausführung meines Codes dauert relativ lange! Ist vielleicht die eine oder andere Variante erstrebenswerter? Oder kann man diesen "Pfusch" total ändern?
Mir scheint CODE relativ lang oder ist er vielleicht doch OK? Die Abfrage in Worksheet_Activate ist nur eine Notlösung (hatte leider kein andern Einfall)
In zelle "z1" steht zur Kontrolle eine SUMMEWENN() weil sonst bei Übertrag und leere ausblenden ein Fehler verursacht wird wenn Spalte A:A leer ist.
so schaut er aus der Code:
Private Sub Worksheet_Activate()
If Range("z1").Value = "0" Then Exit Sub
Call Uebertrag
End Sub
Private Sub Uebertrag()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationAutomatic
End With
Cells.EntireRow.Hidden = False
Application.Calculation = xlCalculationManual
Call KopiePos
Call LeereAusblenden
ActiveSheet.Calculate
Call DoppelAusblenden
Call FormelEinsetzen
ActiveSheet.Calculate
Call WerteAusmass
With Application
.ScreenUpdating = True
.Calculation = xlCalculationManual
End With
End Sub
Private Sub KopiePos()
With Range("aa2:aa2388")
Range("a2:a2388").Value = .Value
Range("a2:a2388").NumberFormat = .NumberFormat
End With
End Sub
Private Sub LeereAusblenden()
Dim rng As Range
Dim iRow As Integer, iRowL As Integer
iRowL = Cells(Rows.Count, 1).End(xlUp).Row
For iRow = 1 To iRowL
If Cells(iRow, 1).Value = "" Then
If rng Is Nothing Then
Set rng = Cells(iRow, 1)
Else
Set rng = Application.Union(rng, Cells(iRow, 1))
End If
End If
Next iRow
rng.EntireRow.Hidden = True
End Sub
Sub DoppelAusblenden()
Dim rng As Range
Dim iRow As Integer, iRowL As Integer
iRowL = Cells(Rows.Count, 26).End(xlUp).Row
For iRow = 26 To iRowL
If Cells(iRow, 26).Value > 1 Then
If rng Is Nothing Then
Set rng = Cells(iRow, 26)
Else
Set rng = Application.Union(rng, Cells(iRow, 26))
End If
End If
Next iRow
rng.EntireRow.Hidden = True
End Sub
Private Sub FormelEinsetzen()
Dim iRow As Integer
iRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("B2").Formula = _
"=SUM(SUMIF(INDIRECT({1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16;17;18;19;20;21;22;23;24;25;26;27;28;29;30;31}&"".""&""!CY:CY""),INDIRECT(""A""&ROW()),INDIRECT({1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16;17;18;19;20;21;22;23;24;25;26;27;28;29;30;31}&"".""&""!DF:DF"")))"
Range("B2:B" & iRow).FillDown
End Sub
Private Sub WerteAusmass()
With Range("b2:b2388")
Range("b2:b2388").Value = .Value
Range("b2:b2388").NumberFormat = .NumberFormat
End With
End Sub
Private Sub Worksheet_Deactivate()
Range("A2:C2388").ClearContents
End Sub