Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1032to1036
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro schneller machen!!!

Makro schneller machen!!!
15.12.2008 10:43:00
Ralf
Hallo,
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

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro schneller machen!!!
15.12.2008 10:46:00
Hajo_Zi
Hallo Ralf,
Excel ist ein vielseitiges Programm und man kann viele Probleme damit lösen. Jede positive Seite hat aber auch negative Aspekte - einer davon ist im Makrorecorder enthalten.
Die Bücher, die es zu Excel VBA gibt, erklären viele Funktionen, aber ich habe bisher nur in einem gelesen, dass der vom Makrorecorder aufgezeichnete Code bereinigt werden sollte.
Der Makrorecorder zeichnet alle Aktionen auf, u. a. auch das Auswählen einer Zelle oder eines eingebetteten Objektes (Bild, Diagramm, Zeichnungsobjekt usw.) dabei wird generell Select und Activate aufgezeichnet. Diese Befehle sind in VBA zu 99,9% nicht notwendig. Sie lassen den Bildschirm flackern und senken die Geschwindigkeit bei der Ausführung des Codes. Man sollte also schon von Beginn an bei der Programmierung darauf achten, solche Befehle zu vermeiden. Meine Erfahrung mit dem Vorsatz: Das mache ich später ist, man schreibt das Programm später meist komplett neu. Also kostest es nicht nur Rechnerzeit sondern auch Deine Zeit und ist Dir Deine Zeit so wenig Wert?
Zum Vergleich mit und ohne Select schau Dir auch mal diese Beispielarbeitsmappe an: mit und ohne select Auf meiner Homepage sind alle meine Beispiele ohne Select. Da kann man sich also einige Lösungsansätze zu diesem Thema ansehen.
verschiebe die Zeile Application.ScreenUpdating = True ans Ende.

Anzeige
AW: Makro schneller machen!!!
15.12.2008 11:04:00
Rudi
Hallo,
1. Application.ScreenUpdating am Anfang auf False setzen!
2. Auf Select verzichten.
3. Mach nichts mehrfach
4. Die Ausblende-Schleifen besser so:

i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Rel. transref.") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop


Gruß
Rudi

AW: Makro schneller machen!!!
15.12.2008 14:38:09
Ralf
Hallo Hajo und Rudi,
vielen Dank für eure Tipps. Ich habe das Makro jetzt folgendermassen geändert (siehe unten). Falls euch noch weitere Verbesserungsvorschläge einfallen, wäre ich euch sehr dankbar.

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

Anzeige
AW: Makro schneller machen!!!
15.12.2008 14:43:55
Ralf
Verzeihung, folgendes Makro habe ich neu gestaltet:

Sub Trades_formatieren()
Dim i As Long
Workbooks.Open Filename:= _
"h:\rk\formatieren.xls"
'leere Spalten ausblenden
Application.ScreenUpdating = False
For i = 1 To 36
Columns(i).Hidden = Application.CountA(Columns(i)) = 0
Next
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
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Rel. transref.") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Comm.") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Fees") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Tax") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Others") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Interest") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Interest days") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Trade Time") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Trade time") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Place of trade") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Broker ID type") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Broker ID") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Counterparty ID type") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Counterparty ID") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Tic Size") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Tic Value") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "FX -Rate") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Portfolio ID Custodian") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Margin") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Net price") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Rel.Transref") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Limit") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Valid Date") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Total Units") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Unit Price") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Execute Broker ID(BIC)") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "CODE") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Principal") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Transaction") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Unit Price") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "NO.") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Broker geglättet") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Handelstag") Then
Columns(i).Hidden = True
End If
i = i + 1
Loop
Range("a10").Select
i = 1
Do Until Cells(10, i).Value = ""
If InStr(1, Cells(10, i).Value, "Valuta") Then
Columns(i).Hidden = True
End If
i = i + 1
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
'leere Spalten ausblenden
Application.ScreenUpdating = True
ActiveWorkbook.Save
End Sub


Sorry!

Anzeige
AW: Makro schneller machen!!!
15.12.2008 15:19:04
Daniel
Hi
also mal als grundsätzliche Verbesserung:
- jedes mal wenn du:
Range(xy).Select
With Selection

schreibst, kannst du auch gleich
With Range(xy)
verwenden. Das selektieren ist hier nicht notwendig.
deine ganzen DO-Schleifen kannst du auch alle in einer zusammenfassen (uzumindest die, in denen ausgeblendet wird)

dim x as long
Do Until Cells(10, i).Value = ""
x = 0
x = x + InStr(1, Cells(10, i).Value, "Rel. transref.")
x = x + InStr(1, Cells(10, i).Value, "Comm.")
x = x + InStr(1, Cells(10, i).Value, "Fees")
'... so mit allen weiteren Begriffen fortfahren, die ausgeblendet werden sollen
if x > 0 then Columns(i).Hidden = True
i = i + 1
Loop


allerdings solltest du mal zählen, ob mehr ausgeblendet oder mehr eingeblendet wird.
wenn mehr Spalten aus- als eingeblendet werden, könnte es auch sinnvoller sein, erst alles auszublenden und dann die einzelnen Spalten einzublenden.
unter der Vorraussetzung, daß alle Suchbegriffe genau 1x vorkommen, könnte man das Ausblenden auch so umsetzen:


Dim rngAus as range
Set rngAus = Rows(10).find(what:="Rel. transref.", lookat:=xlpart)
set rngAus = Union(rngAus, Rows(10).find(what:="Comm.", lookat:=xlpart))
set rngAus = Union(rngAus, Rows(10).find(what:="Fees.", lookat:=xlpart))
'--- auch hier wieder für alle Spaltenfortführen, die ausgeblendet werden sollen
rngAus.entirecolumn.hidden = true


noch einfacher ist, du definierst dir alle Spalten, die Ausgeblendet werden sollen vorab mal als Excel-Namen (unter EINFÜGEN-NAMEN-DEFINIEREN)
und blendest dann im Makro mit


Range("DeinName").EntireColumn.Hidden = True


aus
Gruß, Daniel

Anzeige
AW: Makro schneller machen!!!
15.12.2008 17:28:24
Ralf
Hallo Daniel,
vielen Dank für deine Tipps. Ich habe die beiden unten aufgeführten Varianten mal ausprobiert. Sie funktionieren noch nicht. Vielleicht kannst du die Fehler finden.
Do Until Cells(10, i).Value = ""
x = 0
x = x + InStr(1, Cells(10, i).Value, "Rel. transref.")
x = x + InStr(1, Cells(10, i).Value, "Comm.")
x = x + InStr(1, Cells(10, i).Value, "Fees")
x = x + InStr(1, Cells(10, i).Value, "Tax")
x = x + InStr(1, Cells(10, i).Value, "Others")
x = x + InStr(1, Cells(10, i).Value, "Interest")
x = x + InStr(1, Cells(10, i).Value, "Interest days")
x = x + InStr(1, Cells(10, i).Value, "Trade Time")
x = x + InStr(1, Cells(10, i).Value, "Place of trade")
x = x + InStr(1, Cells(10, i).Value, "Broker ID type")
x = x + InStr(1, Cells(10, i).Value, "Broker ID")
x = x + InStr(1, Cells(10, i).Value, "Counterparty ID type")
x = x + InStr(1, Cells(10, i).Value, "Counterparty ID")
x = x + InStr(1, Cells(10, i).Value, "Tic Size")
x = x + InStr(1, Cells(10, i).Value, "Tic Value")
x = x + InStr(1, Cells(10, i).Value, "FX -Rate")
x = x + InStr(1, Cells(10, i).Value, "Portfolio ID Custodian")
x = x + InStr(1, Cells(10, i).Value, "Margin")
x = x + InStr(1, Cells(10, i).Value, "Net price")
x = x + InStr(1, Cells(10, i).Value, "Limit")
x = x + InStr(1, Cells(10, i).Value, "Valid Date")
x = x + InStr(1, Cells(10, i).Value, "Total Units")
x = x + InStr(1, Cells(10, i).Value, "Unit Price")
x = x + InStr(1, Cells(10, i).Value, "Execute Broker ID(BIC)")
x = x + InStr(1, Cells(10, i).Value, "CODE")
x = x + InStr(1, Cells(10, i).Value, "Principal")
x = x + InStr(1, Cells(10, i).Value, "Transaction")
x = x + InStr(1, Cells(10, i).Value, "Unit Price")
x = x + InStr(1, Cells(10, i).Value, "NO.")
x = x + InStr(1, Cells(10, i).Value, "Broker geglättet")
x = x + InStr(1, Cells(10, i).Value, "Handelstag")
x = x + InStr(1, Cells(10, i).Value, "Valuta")
If x größer(das Zeichen konnte ich hier nicht verwenden, sonst hätte ich es nicht ins Forum stellen können, warum auch immer) 0 Then Columns(i).Hidden = True
i = i + 1
Loop
----es wird nichts ausgeblendet!
Set rngaus = Rows(10).Find(what:="Rel. transref.", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Comm.", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Fees", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Tax", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Others", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Interest", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Interest days", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Trade Time", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Place of trade", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Broker ID type", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Broker ID", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Counterparty ID type", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Counterparty ID", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Tic Size", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Tic Value", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="FX -Rate", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Portfolio ID Custodian", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Margin", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Net price", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Limit", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Valid Date", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Total Units", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Unit Price", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Execute Broker ID(BIC)", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="CODE", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Principal", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Transaction", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Unit Price", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="NO.", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Broker geglättet", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Handelstag", lookat:=xlPart)
Set rngaus = Rows(10).Find(what:="Valuta", lookat:=xlPart)
rngaus.EntireColumn.Hidden = True
---- der Debugger meldet sich bei: rngaus.EntireColumn.Hidden = True
Viele Grüße
Ralf
Anzeige
AW: Makro schneller machen!!!
15.12.2008 17:31:18
Daniel
Hi
lad mal ne beispieldatei hoch, ich hab jetzt keine Lust, das nachzubauen.
Gruß, Daniel
AW: Makro schneller machen!!!
15.12.2008 18:05:00
Daniel
Hi
hab jetzt doch noch mal draufgeschaut,
Version 1. funktioniert einwandfrei.
bei Version 2 hast du übersehen, das der Code ab der 2 Zeile anders ist als in der ersten, d.h. du musst die 2. Zeile nach unten fortsetzen, nicht die erste (also die mit UNION(..))
in der 2. Version werden einige Spalten nicht ausgeblendet, weil die Namensgebung nicht eindeutig ist.
allerdings könnte man damit abhelfen, daß man statt LookAt:=xlPart dann LookAt:=xlWhole verwendet.
allerdings müssen in Version 2 dann alle Spaltenbeschriftungen genau so vorkommen.
hier die Beispiele.
https://www.herber.de/bbs/user/57638.xls
Gruß, Daniel
Anzeige
AW: Makro schneller machen!!!
16.12.2008 17:11:15
Ralf
Hallo Daniel,
super, vielen Dank! funktioniert.
vg
Ralf

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige