Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
616to620
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
616to620
616to620
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro tunen!

Makro tunen!
01.06.2005 11:20:51
Sammy
Hallo Ihrs!
Leider beinhaltet meine Praktikantenarbeit das erstelln von Projektionen. Diese werden von unserem System aber nur halbfertig ausgeliefert und ich darf sie dann mit Formatierungen und Summenbildungen aufwerten.
Dieses stellt ja an sich kein Problem, leider häufen sich diese aber und es macht kein Spaß. Nun bin ich auf die Idee gekommen das man dafür doch ein Makro benutzen könnte.
Mein Problem: Alle Projektionen kommen gleich bei mir an, nur die länge ist unterschiedlich. Nun habe ich folgendes Makro gemacht:
&ltpre&gt
Sub Projektion()
'
' Projektion Makro
' Makro am 01.06.2005 von sammyabushab aufgezeichnet
'
' Tastenkombination: Strg+q
'
Columns("E:Y").Select
Selection.Delete Shift:=xlToLeft
Range("D1").Select
Selection.Copy
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("E2").Select
With Selection.Interior
.ColorIndex = 47
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveCell.FormulaR1C1 = "Costs"
With ActiveCell.Characters(Start:=1, Length:=5).Font
.Name = "Verdana"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = 2
End With
Range("E3").Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-2]"
Range("E4").Select
ActiveWindow.ScrollColumn = 1
Range("E3").Select
Selection.AutoFill Destination:=Range("E3:E245"), Type:=xlFillDefault
Range("E3:E245").Select
Range("A246").Select
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveCell.FormulaR1C1 = "TOTAL"
With ActiveCell.Characters(Start:=1, Length:=5).Font
.Name = "Verdana"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("B246").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-243]C:R[-1]C)"
Range("C246").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-243]C:R[-1]C)"
Range("E246").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-243]C:R[-1]C)"
Range("D246").Select
ActiveCell.FormulaR1C1 = "=RC[1]/RC[-1]"
Range("A246:E246").Select
Range("E246").Activate
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.Underline = xlUnderlineStyleSingle
Selection.Font.Bold = True
Range("A3:E245").Select
Range("E245").Activate
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
ActiveWindow.ScrollRow = 229
ActiveWindow.ScrollRow = 228
ActiveWindow.ScrollRow = 227
ActiveWindow.ScrollRow = 226
ActiveWindow.ScrollRow = 225
ActiveWindow.ScrollRow = 223
ActiveWindow.ScrollRow = 222
ActiveWindow.ScrollRow = 220
ActiveWindow.ScrollRow = 218
ActiveWindow.ScrollRow = 216
ActiveWindow.ScrollRow = 213
ActiveWindow.ScrollRow = 211
ActiveWindow.ScrollRow = 208
ActiveWindow.ScrollRow = 206
ActiveWindow.ScrollRow = 203
ActiveWindow.ScrollRow = 199
ActiveWindow.ScrollRow = 197
ActiveWindow.ScrollRow = 194
ActiveWindow.ScrollRow = 185
ActiveWindow.ScrollRow = 183
ActiveWindow.ScrollRow = 175
ActiveWindow.ScrollRow = 166
ActiveWindow.ScrollRow = 163
ActiveWindow.ScrollRow = 156
ActiveWindow.ScrollRow = 148
ActiveWindow.ScrollRow = 139
ActiveWindow.ScrollRow = 132
ActiveWindow.ScrollRow = 125
ActiveWindow.ScrollRow = 118
ActiveWindow.ScrollRow = 110
ActiveWindow.ScrollRow = 103
ActiveWindow.ScrollRow = 95
ActiveWindow.ScrollRow = 92
ActiveWindow.ScrollRow = 84
ActiveWindow.ScrollRow = 77
ActiveWindow.ScrollRow = 74
ActiveWindow.ScrollRow = 67
ActiveWindow.ScrollRow = 60
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 50
ActiveWindow.ScrollRow = 47
ActiveWindow.ScrollRow = 45
ActiveWindow.ScrollRow = 42
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 37
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 32
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 28
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 25
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Range("A2:E245").Select
Range("E245").Activate
Selection.Sort Key1:=Range("C3"), Order1:=xlDescending, Key2:=Range("B3") _
, Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
ActiveWindow.ScrollRow = 229
ActiveWindow.ScrollRow = 228
ActiveWindow.ScrollRow = 227
ActiveWindow.ScrollRow = 226
ActiveWindow.ScrollRow = 225
ActiveWindow.ScrollRow = 224
ActiveWindow.ScrollRow = 223
ActiveWindow.ScrollRow = 222
ActiveWindow.ScrollRow = 221
ActiveWindow.ScrollRow = 219
ActiveWindow.ScrollRow = 218
ActiveWindow.ScrollRow = 215
ActiveWindow.ScrollRow = 214
ActiveWindow.ScrollRow = 212
ActiveWindow.ScrollRow = 210
ActiveWindow.ScrollRow = 208
ActiveWindow.ScrollRow = 206
ActiveWindow.ScrollRow = 204
ActiveWindow.ScrollRow = 202
ActiveWindow.ScrollRow = 199
ActiveWindow.ScrollRow = 197
ActiveWindow.ScrollRow = 194
ActiveWindow.ScrollRow = 187
ActiveWindow.ScrollRow = 184
ActiveWindow.ScrollRow = 177
ActiveWindow.ScrollRow = 174
ActiveWindow.ScrollRow = 167
ActiveWindow.ScrollRow = 160
ActiveWindow.ScrollRow = 156
ActiveWindow.ScrollRow = 149
ActiveWindow.ScrollRow = 146
ActiveWindow.ScrollRow = 143
ActiveWindow.ScrollRow = 140
ActiveWindow.ScrollRow = 133
ActiveWindow.ScrollRow = 125
ActiveWindow.ScrollRow = 118
ActiveWindow.ScrollRow = 110
ActiveWindow.ScrollRow = 103
ActiveWindow.ScrollRow = 94
ActiveWindow.ScrollRow = 87
ActiveWindow.ScrollRow = 79
ActiveWindow.ScrollRow = 70
ActiveWindow.ScrollRow = 62
ActiveWindow.ScrollRow = 54
ActiveWindow.ScrollRow = 47
ActiveWindow.ScrollRow = 38
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveWindow.SmallScroll Down:=-9
Columns("D:E").Select
Selection.NumberFormat = "#,##0.00 $"
Columns("B:C").Select
Selection.Style = "Comma"
Selection.NumberFormat = _
"_-* #,##0.0 _€_-;-* #,##0.0 _€_-;_-* ""-""? _€_-;_-@_-"
Selection.NumberFormat = "_-* #,##0 _€_-;-* #,##0 _€_-;_-* ""-""? _€_-;_-@_-"
Range("D13").Select
ActiveWindow.SmallScroll Down:=150
ActiveWindow.ScrollRow = 150
ActiveWindow.ScrollRow = 149
ActiveWindow.ScrollRow = 148
ActiveWindow.ScrollRow = 147
ActiveWindow.ScrollRow = 146
ActiveWindow.ScrollRow = 145
ActiveWindow.ScrollRow = 143
ActiveWindow.ScrollRow = 141
ActiveWindow.ScrollRow = 139
ActiveWindow.ScrollRow = 137
ActiveWindow.ScrollRow = 135
ActiveWindow.ScrollRow = 133
ActiveWindow.ScrollRow = 130
ActiveWindow.ScrollRow = 128
ActiveWindow.ScrollRow = 121
ActiveWindow.ScrollRow = 118
ActiveWindow.ScrollRow = 115
ActiveWindow.ScrollRow = 112
ActiveWindow.ScrollRow = 104
ActiveWindow.ScrollRow = 97
ActiveWindow.ScrollRow = 91
ActiveWindow.ScrollRow = 88
ActiveWindow.ScrollRow = 85
ActiveWindow.ScrollRow = 82
ActiveWindow.ScrollRow = 81
ActiveWindow.ScrollRow = 78
ActiveWindow.ScrollRow = 75
ActiveWindow.ScrollRow = 73
ActiveWindow.ScrollRow = 70
ActiveWindow.ScrollRow = 68
ActiveWindow.ScrollRow = 66
ActiveWindow.ScrollRow = 63
ActiveWindow.ScrollRow = 62
ActiveWindow.ScrollRow = 59
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 55
ActiveWindow.ScrollRow = 53
ActiveWindow.ScrollRow = 51
ActiveWindow.ScrollRow = 49
ActiveWindow.ScrollRow = 47
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 44
ActiveWindow.ScrollRow = 42
ActiveWindow.ScrollRow = 41
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 37
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 33
ActiveWindow.ScrollRow = 32
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Range("E2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B8").Select
End Sub&lt/pre&gt
Besteht die Möglichkeit die länge variabel zu gestalten, so dass er von alleine erkennt wann die Projektion aufhört... und was er alles formatieren und berechnen muss?
Habe eine Datei angehängt mit vorher nachher, bei Fragen stehe ich euch natürlich gerne zur Verfügung.
https://www.herber.de/bbs/user/23469.xls
Viele Grüße
Sammy

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro tunen!
01.06.2005 13:08:14
u_
Hallo,
a) die letzte Zeile bekommst du mit Range("A65536").end(xlup).row
b) die ScrollRow-Befehle kannst du löschen
c) auf Select solltest du verzichten.
d) hier mal ein Stück Code als Anregung:
Sub Projektion()
Columns("E:Y").Delete Shift:=xlToLeft
Range("D1").Copy
Range("E1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With Range("E2")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Value = "Costs"
With .Interior
.ColorIndex = 47
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
With .Font
.Name = "Verdana"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = 2
End With
End With
Range(Cells(3, 5), Cells(65536, 5).End(xlUp)).FormulaR1C1 = "=RC[-1]*RC[-2]"
Gruß
Geist ist geil!
Anzeige
AW: Makro tunen!
01.06.2005 13:40:17
Harald
Hallo Sammy,
so. Zuerst hab ich mal über die Hälfte Code rausgeschmissen.
(scrollen im Code braucht kein Mensch ;-))
Guck dir LZeile an. Die bestimmt dir die letzte gefüllte Zelle in einer Spalte. In diesem Fall steht eine 1 nach dem Komma. Also erste Spalte = A)
Soll er eine Zelle tiefer gehen, wäre das beispielsweise
Lzeile = Cells(Rows.Count, 1).End(xlUp).Row + 1
Dim Lzeile as integer (Zähler). das kannst Du für jede Spalte einrichten
LzeileA = Cells(Rows.Count, 1).End(xlUp).Row oder
LzeileB = Cells(Rows.Count, 2).End(xlUp).Row
Statt range("A3:A245").etc heißt es dann
range("a3:a" & LzeileA)
Ansatzweise hab ich am Codeanfang was geschrieben. Den Rest darfste selber. Bin ja nicht so ;-)))


Sub Projektion()
Dim Lzeile as integer
application.screenupdating = false
Lzeile = Cells(Rows.Count, 1).End(xlUp).Row
Columns("E:Y").Delete Shift:=xlToLeft
Range("D1").Copy
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With Range("E2").Interior
.ColorIndex = 47
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
With Range("E2")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.FormulaR1C1 = "Costs"
End With
With ActiveCell.Characters(Start:=1, Length:=5).Font
.Name = "Verdana"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = 2
End With
Range("E3").FormulaR1C1 = "=RC[-1]*RC[-2]"
Range("E3").AutoFill Destination:=Range("E3:E245"), Type:=xlFillDefault
With Range("A246").Interior
.ColorIndex = 2
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
With Range("A246")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.FormulaR1C1 = "TOTAL"
End With
With Range("A246").Characters(Start:=1, Length:=5).Font
.Name = "Verdana"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("B246").FormulaR1C1 = "=SUM(R[-243]C:R[-1]C)"
Range("C246").FormulaR1C1 = "=SUM(R[-243]C:R[-1]C)"
Range("E246").FormulaR1C1 = "=SUM(R[-243]C:R[-1]C)"
Range("D246").FormulaR1C1 = "=RC[1]/RC[-1]"
Range("A246:E246").Select
Range("E246").Activate
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.Underline = xlUnderlineStyleSingle
Selection.Font.Bold = True
Range("A3:E245").Select
Range("E245").Activate
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
Range("A2:E245").Select
Range("E245").Activate
Selection.Sort Key1:=Range("C3"), Order1:=xlDescending, Key2:=Range("B3") _
, Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("D:E").NumberFormat = "#,##0.00 $"
Columns("B:C").Select
Selection.Style = "Comma"
Selection.NumberFormat = _
"_-* #,##0.0 _€_-;-* #,##0.0 _€_-;_-* ""-""? _€_-;_-@_-"
Selection.NumberFormat = "_-* #,##0 _€_-;-* #,##0 _€_-;_-* ""-""? _€_-;_-@_-"
With Range("E2")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B8").Select
application.screenupdating = true
End Sub

Viel Erfolg
Harald
Anzeige
AW: Makro tunen!
01.06.2005 16:33:36
Sammy
Hallo Harald, Hallo Geist!
Sorry, war in nem meeting... danke für eure Teilnahme.
So, sitze grad dran und versuche mir eure Ratschläge zu befolgen. Hab Angefangen und stoße jetzt auf das Problem wie ich ihm sage das er die Summe nehmen soll.
Also in der Summe die Angaben müssen doch auch variabel sein... wie sag ich dem das?
Hier das was ich geschafft hab ( nicht viel aber ich bin ja auch ne VBA-Niete)
&ltpre&gt
Sub Projektion()
'
' Projektion Makro
' Makro am 01.06.2005 von sammyabushab aufgezeichnet
'
' Tastenkombination: Strg+q
'

Dim LzeileA As Integer
Dim LzeileB As Integer

LzeileA = Cells(Rows.Count, 1).End(xlUp).Row + 1
LzeileB = Cells(Rows.Count, 1).End(xlUp).Row + 1

Columns("E:Y").Delete Shift:=xlToLeft
Range("D1").Copy
Range("E1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

With Range("E2")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Value = "Costs"
With .Interior
.ColorIndex = 47
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
With .Font
.Name = "Verdana"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = 2
End With
End With
Range(Cells(3, 5), Cells(65536, 5).End(xlUp)).FormulaR1C1 = "=RC[-1]*RC[-2]"



Lzeile = "Total"
With Lzeile
.Name = "Verdana"
.FontStyle = "Fett"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = 1
End With




LzeileB = "=SUM(R[-243]C:R[-1]C)"
LzeileC = "=SUM(R[-243]C:R[-1]C)"

LzeileE = "=SUM(R[-243]C:R[-1]C)"

LzeileD = "=RC[1]/RC[-1]"
Range("A246:E246").Select
Range("E246").Activate
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.Underline = xlUnderlineStyleSingle
Selection.Font.Bold = True
Range("A3:E245").Select
Range("E245").Activate
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
Range("A2:E245").Select
Range("E245").Activate
Selection.Sort Key1:=Range("C3"), Order1:=xlDescending, Key2:=Range("B3") _
, Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveWindow.SmallScroll Down:=-9
Columns("D:E").Select
Selection.NumberFormat = "#,##0.00 $"
Columns("B:C").Select
Selection.Style = "Comma"
Selection.NumberFormat = _
"_-* #,##0.0 _€_-;-* #,##0.0 _€_-;_-* ""-""? _€_-;_-@_-"
Selection.NumberFormat = "_-* #,##0 _€_-;-* #,##0 _€_-;_-* ""-""? _€_-;_-@_-"
Range("D13").Select
ActiveWindow.SmallScroll Down:=150
Range("E2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B8").Select
End Sub&lt/pre&gt
Danke vorab!
Gruß
Die Niete
Anzeige
AW: Makro tunen!
01.06.2005 16:37:48
Sammy
Wie dumm von mir...
Danke Harald, die Antwort darauf hab ich dann jetzt auch gefunden...
Na, ist doch prima. geschlossen o.T.
02.06.2005 08:19:40
Harald
Gruß
Harald

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige