Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert sind; Die von diesem Forum gesetzten Cookies düfen nur auf dieser Website verwendet werden und stellen kein Sicherheitsrisiko dar. Cookies auf diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Die Updates sind abgeschlossen. Bitte meldet eventuelle Bugs und Auffälligkeiten im entsprechenden Forum.
Sollte das Loginfenster nicht sichtbar sein, ist es unten links. Entweder Ihr loggt Euch dort ein oder löscht den Browsercache und versucht es noch einmal.


Makro Aufzeichnung zusammen fassen
#1
Hallo zusammen,

ich benötige mal Hilfe. Kann mir jemand mal meinen VBA-Code, den ich mit Recorder aufgezeichnet habe, zusammen fassen (optimieren). Bekomme das einfach nicht hin.

Hier mein Code:
Code:
Sub aktualisieren()
'
' aktualisieren Makro
'

'
    Sheets("DAX").Select
    Columns("S:U").Select
    Selection.Copy
    Sheets("Total").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("D:D").ColumnWidth = 0.88
    Selection.Columns.AutoFit
    Columns("E:G").Select
    Sheets("TECDAX").Select
    Columns("S:U").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Total").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Columns.AutoFit
    Columns("H:H").ColumnWidth = 0.88
    Columns("I:K").Select
    Sheets("MDAX").Select
    Columns("S:U").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Total").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Columns.AutoFit
    Columns("L:L").ColumnWidth = 0.88
    Columns("M:O").Select
    Sheets("SDAX").Select
    Columns("S:U").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Total").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Columns.AutoFit
    Columns("P:P").ColumnWidth = 1.33
    Columns("Q:S").Select
    Sheets("DOW JONES").Select
    Columns("S:U").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Total").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Columns.AutoFit
    Columns("U:AA").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("G2:J2").Select
    ActiveWindow.LargeScroll ToRight:=-1
    Range("A2:C2,E2:G2,I2:K2,M2:O2,Q2:S2").Select
    Range("Q2").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 13434828
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A2:C32,E2:G32,I2:K52,M2:O52,Q2:S32").Select
    Range("Q2").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Range("A2:B2").Select
    ActiveSheet.Shapes.Range(Array("Button 1")).Select
    ActiveSheet.Shapes.Range(Array("Button 1", "Button 2")).Select
    ActiveSheet.Shapes.Range(Array("Button 1", "Button 2", "Button 3")).Select
    ActiveSheet.Shapes.Range(Array("Button 1", "Button 2", "Button 3", _
        "Button 4")).Select
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Height = 28.5
    Selection.ShapeRange.Width = 170.25
    Selection.ShapeRange.IncrementLeft -42.75
    Selection.ShapeRange.IncrementTop 3
    Range("W17").Select
    ActiveSheet.Shapes.Range(Array("Button 2")).Select
    ActiveSheet.Shapes.Range(Array("Button 2", "Button 3")).Select
    ActiveSheet.Shapes.Range(Array("Button 2", "Button 3", "Button 4")).Select
    Selection.Delete
    Range("T19").Select
End Sub


Sub fiter_neu()
'
' fiter_neu Makro
'

'
    Range("A2:B2").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "A2"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Total").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter
    Range("E2:F2").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "E2"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Total").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter
    Range("I2:J2").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "I2"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Total").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter
    Range("M2:N2").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "M2"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Total").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter
    Range("Q2:R2").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Total").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "Q2"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Total").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter
    Range("A3:A32").Select
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueNumber
    Selection.FormatConditions(1).ColorScaleCriteria(1).Value = 0
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercent
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 25
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueNumber
    Selection.FormatConditions(1).ColorScaleCriteria(3).Value = 3
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 65280
        .TintAndShade = 0
    End With
    Range("A3").Select
    Selection.Copy
    Range("E3:E32,I3:I52,M3:M52,Q3:Q32").Select
    Range("Q3").Activate
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    Sheets("Total").Select
End Sub

Vielen Dank schon mal im Voraus!!!
Grüße aus Bremen
Bernie

"Wenn du jemanden triffst ohne lächeln, schenke ihm deins !!!"

MS Office 2016 Pro  32bit - Win 10 Pro 64 bit
Haftungshinweis: Trotz sorgfältiger inhaltlicher Kontrolle übernehmen ich keine Haftung für die Inhalte externer Links. Für den Inhalt der verlinkten Seiten sind ausschließlich deren Betreiber verantwortlich.
Antwortento top
#2
@alle

Hab selber ne Lösung gefunden, mit der ich leben kann.
Grüße aus Bremen
Bernie

"Wenn du jemanden triffst ohne lächeln, schenke ihm deins !!!"

MS Office 2016 Pro  32bit - Win 10 Pro 64 bit
Haftungshinweis: Trotz sorgfältiger inhaltlicher Kontrolle übernehmen ich keine Haftung für die Inhalte externer Links. Für den Inhalt der verlinkten Seiten sind ausschließlich deren Betreiber verantwortlich.
Antwortento top
#3
Hallo Bernd,

könntest Du die Lösung, wo Du jetzt verwendest hier posten?
Gruß Stefan
Win 7 / Office 2007
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste