08.05.2019, 21:08
Hallöchen,
Wenn da ein Makro läuft, ist das von Dir / kennst Du dich damit aus?
Als weiteren "Teil eines Makros"
hätte ich die beschriebenen Aktionen mal aufgezeichnet und eingekürzt.
Das müsste man dann sicher noch flexibilisieren, falls ein längerer Bereich zu erwarten ist oder falls er kürzer wird, muss man den Zielbereich ggf. zuerst leeren.
Wenn da ein Makro läuft, ist das von Dir / kennst Du dich damit aus?
Als weiteren "Teil eines Makros"
hätte ich die beschriebenen Aktionen mal aufgezeichnet und eingekürzt. Das müsste man dann sicher noch flexibilisieren, falls ein längerer Bereich zu erwarten ist oder falls er kürzer wird, muss man den Zielbereich ggf. zuerst leeren.
Code:
Option Explicit
Sub Makro1()
Range("A1:B29").Select
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add2 Key:=Range( _
"B2:B29"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add2 Key:=Range( _
"A2:A29"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Tabelle1").Sort
.SetRange Range("A1:B29")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("C2:C29").FormulaR1C1 = "=IF(COUNTIF(RC1:R29C1,RC[-2])>1,""x"","""")"
Range("A1:C29").AutoFilter
ActiveSheet.Range("$A$1:$C$29").AutoFilter Field:=3, Criteria1:="="
Range("A1:B29").Copy
Range("H1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
Range("$A$1:$C$29").AutoFilter
End Sub