Das folgende Makro habe ich für acht Buchungskreise zusammengebastelt (mir Eurer Hilfe). Alles befindet sich in der gleichen Arbeitsmappe.
Jeder Kreis hat ein Berechnungsblatt und ein Datenblatt. Im Ersteren befindet sich eine Schaltfläche. Diese wird für jeden Kreis einzeln gestartet.
Grundsätzlich funktioniert das Ganze... aber extrem langsam bei den letzen Schritten Spalten löschen und Formatierungen. Als ich nur ein Modul testete war es sehr schnell. Nun warte ich mind. 10 Sekunden.
Sub xxxxx()
' Makro am 14.07.2009 aufgezeichnet
' Tastenkombination: Strg+q
Sheets("1600 Daten").Select
Dim RaFound As Range
Dim LoLetzte As Long
Dim sSearch As String
sSearch = "Saldo pro Buchungskreis"
With Worksheets("1600 Daten")
' xlByRows Suche zuerst in Zeilen
' xlByColumns Suche zuerst in Spalten
Set RaFound = .Cells.Find(sSearch, , , xlWhole, xlByRows, xlNext)
If RaFound Is Nothing Then Exit
Sub 'falls nicht gefunden wird
Sub verlassen
Rows("1:" & RaFound.Row - 1).Delete
End With
Set RaFound = Nothing
Columns("B:C").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("D:E").Select
Selection.Delete Shift:=xlToLeft
Columns("F:K").Select
Selection.Delete Shift:=xlToLeft
Columns("H:M").Select
Selection.Delete Shift:=xlToLeft
Columns("I:I").Select
Selection.Delete Shift:=xlToLeft
Columns("J:K").Select
Selection.Delete Shift:=xlToLeft
Cells.Select
Range("B1").Activate
Selection.Replace What:=",", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Select
Cells.EntireColumn.AutoFit
Columns("D:D").Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("G:J").Select
Selection.NumberFormat = "#,##0.00"
Sheets("1600").Select
End Sub
Wie kann ich das Ganze beschleunigen?
Vielen Dank für die Hilfe
Gruss
Frédéric