Makro für mehrere Arbeitsschritte

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
danke für den Denkanstoß. Ich bin bisher schon bei der Textzahlenumwandlung gescheitert und hatte somit am Anfang aufgegeben...
Mit diesem Code scheint mein Problem gelöst:


Sub AME_BME()
' Autofilter aktivieren
Range("A1").Select
Selection.AutoFilter
'Oberste Zeile einfrieren
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
' Textzahlen in Spalte A umwandeln in Zahlen
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("A:A").NumberFormat = "General"
' AME "ST" einfügen
Columns("F:F").Select
Selection.Replace What:="", Replacement:="ST", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' BME "ST" einfügen
Columns("H:H").Select
Selection.Replace What:="", Replacement:="ST", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' UmrFaktor AME "1" einfügen
ActiveSheet.Range("$A$1:$K$843").AutoFilter Field:=7, Criteria1:="0,00000"
Columns("G:G").Select
Selection.Replace What:="0", Replacement:="1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveSheet.Range("$A$1:$K$843").AutoFilter Field:=7
' UmrFaktor BME "1" einfügen
ActiveSheet.Range("$A$1:$K$843").AutoFilter Field:=9, Criteria1:="0,00000"
Columns("G:G").Select
Columns("I:I").Select
Selection.Replace What:="0", Replacement:="1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
ActiveSheet.Range("$A$1:$K$843").AutoFilter Field:=9
' Speichern und Schließen
ActiveWorkbook.Save
ActiveWindow.Close
End Sub

Vielleicht geht es noch eleganter, aber für das erste Mal bin ich ganz zufrieden!
Gruß
PeMoe

Sub AME_BME() Application.ScreenUpdating = False ' Autofilter aktivieren Range("A1").AutoFilter 'Oberste Zeile einfrieren Range("A2").Select ActiveWindow.FreezePanes = True ' Textzahlen in Spalte A umwandeln in Zahlen Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _ :=Array(1, 1), TrailingMinusNumbers:=True Columns("A:A").NumberFormat = "General" ' AME "ST" einfügen Columns("F:F").Replace What:="", Replacement:="ST", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ' BME "ST" einfügen Columns("H:H").Replace What:="", Replacement:="ST", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ' UmrFaktor AME "1" einfügen ActiveSheet.Range("$A:$K").AutoFilter Field:=7, Criteria1:="0,00000" Columns("G:G").Replace What:="0", Replacement:="1", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ActiveSheet.ShowAllData ' UmrFaktor BME "1" einfügen ActiveSheet.Range("$A:$K").AutoFilter Field:=9, Criteria1:="0,00000" Columns("I:I").Replace What:="0", Replacement:="1", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select ActiveSheet.ShowAllData ' Speichern und Schließen ActiveWindow.Close True End Sub

Beliebteste Forumthreads (12 Monate)

Makro für mehrere Arbeitsschritte

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread