AW: Bin zwar Tierfreund...
02.08.2010 16:21:20
Ramses
Hallo
hab dir das Makro mal etwas optimiert.
Ist zwar ungetestet, sollte aber tun
Sub test()
Dim myRng As Range, rngAddress As String
On Error GoTo myErrHandler
'Ausschalten der Bildschirmaktualisierung und Berechnung.
'Beim einfügen der Formel wird jedesmal neu berechnet und das kostet Zeit
'ebenso die vielen Selects und Bildsschirmänderungen
With Application
.ScreenUpdating = False
.Calculate = xlManual
End With
Columns("A:A").ColumnWidth = 7.71
Columns("B:M").EntireColumn.AutoFit
Range("L:L,N:N").NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
With Range("P3")
.FormulaR1C1 = "=IF(RC[-14]="""","""",VLOOKUP(ABS(SUM(RC[-14]:RC[-13])-222),[VERSNr.xls]Tabelle1!C1:C2,2,0))"
.AutoFill Destination:=Range("P3:P346"), Type:=xlFillDefault
End With
With Range("Q3")
.FormulaR1C1 = "=IF(RC[-6]="""","""",IF(RC[-6]<>""EUR"",1,0))"
.AutoFill Destination:=Range("Q3:Q2000"), Type:=xlFillDefault
End With
With Range("A3:=2000")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=SUMME($Q3)=1"
.FormatConditions(1).Interior.ColorIndex = 15
End With
Columns("Q:Q").EntireColumn.Hidden = True
'ANFANG DER SCHLEIFE
Set myRng = Cells.Find(what:="Saldo", after:=ActiveCell, LookIn:=xlFormulas, _
lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If Not myRng Is Nothing Then
rngAddress = myRng.Address
Do
'Application.Goto myRng, True
myRng.Offset(1, 0).Rows("1:1").EntireRow.Insert
On Error Resume Next
Set myRng = Cells.FindNext(after:=ActiveCell)
If myRng.Address = rngAddress Then Exit Do
Err.Clear
Loop
End If
'ENDE DER SCHLEIFE
errExit:
With Application
.ScreenUpdating = True
.Calculate = xlAutomatic
End With
Range("A1").Select
Exit Sub
myErrHandler:
MsgBox "Es ist ein Fehler aufgetreten: " & vbclrf & Err.Number & ": " & Err.Description
Resume errExit
End Sub
Wo allerdings die eingangs erwähnte SVERWEIS Formel ist die neben "Saldo" zur Angzeige kommen soll, habe ich nicht gefunden
Gruss Rainer