Makro schneller machen!!!
15.12.2008 10:43:00
Ralf
wir benutzen unten aufgeführtes Makro, welches soweit einwandfrei funktioniert. Jedoch benötigt es einige Zeit, so dass ich fragen möchte, ob es eine Möglichkeit gibt, die Ausführung zu beschleunigen?
Sub Trades_formatieren()
Dim i As Long
Workbooks.Open Filename:= _
"h:\rk\formatieren.xls"
Application.ScreenUpdating = False
For i = 1 To 36
Columns(i).Hidden = Application.CountA(Columns(i)) = 0
Next
Application.ScreenUpdating = True
Rows("1:9").Select
With Selection.Font
.Name = "Times New Roman"
.FontStyle = "Standard"
.Size = 1
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Rows("10:10").Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Rows("11:200").Select
ActiveWindow.LargeScroll Down:=-4
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Selection.RowHeight = 25
Cells.Select
Cells.EntireColumn.AutoFit
Rows("1:9").Select
With Selection.Font
.Name = "Times New Roman"
.FontStyle = "Standard"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Columns("A:AI").Select
ActiveSheet.PageSetup.PrintArea = "$A:$AI"
ActiveWindow.SmallScroll ToRight:=0
Range("E13").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A:$AI"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.196850393700787)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.984251969)
.BottomMargin = Application.InchesToPoints(0.984251969)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Rel. transref.") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Comm.") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Fees") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Tax") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Others") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Interest") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Interest days") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Trade time") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Place of trade") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Broker ID type") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Broker ID") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Counterparty ID type") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Counterparty ID") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Tic size") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Tic value") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "FX-Rate") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Portfolio ID Custodian") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Margin") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Net price") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Rel. Transref") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Limit") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Valid date") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Total Units") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Unit Price") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Execute Broker ID(BIC)") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "CODE") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Principal") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Transaction") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Unit Price") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "NO.") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Broker geglättet") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Handelstag") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Valuta") Then
Selection.EntireColumn.Hidden = True
End If
ActiveCell.Offset(0, 1).Select
Loop
Range("a10").Select
Do Until ActiveCell.Value = ""
If InStr(1, ActiveCell.Value, "Interest rate") Then
Selection.EntireColumn.Hidden = False
End If
ActiveCell.Offset(0, 1).Select
Loop
Columns("aj:aj").Select
Selection.EntireColumn.Hidden = True
ActiveWorkbook.Save
End Sub
Viele Grüße
Ralf