Duplikate entfernen und Werte gleichzeitig sortier

Hallo Christian,
wozu?
Das Makro macht genau das, was du willst. Geschwindigkeit ist auch kein Problem. RemoveDuplicates und Sortieren sind sehr schnell und die Kopiervorgänge erfolgen im Block, daher auch unproblematisch. Einfach mal ausprobieren.
Hab jetzt aber noch eine kleine Erweiterung. Hier wird dann im Zielblatt die Formatierung aus Zelle C2 übernommen und in sämtliche Überschriften kopiert.

Public Sub Duplikate_raus()
Dim loLetzte As Long
Dim loLetzte1 As Long
Dim letzteSpalte As Long
Application.ScreenUpdating = False
With Sheets("tbl_UAE01")
loLetzte = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range(.Cells(2, 2), .Cells(loLetzte, 2)).Copy _
Sheets("tbl_test3").Range("B1")
End With
With Sheets("tbl_test3")
.Range("B:B").RemoveDuplicates Columns:=1, Header:=xlNo
loLetzte1 = .Cells(.Rows.Count, 2).End(xlUp).Row
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("B1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
With ActiveWorkbook.Worksheets("tbl_test3").Sort
.SetRange Range("B1:B" & loLetzte1)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
With Sheets("tbl_test3")
.Range("B1:B" & loLetzte1).Copy
.Range("C2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
letzteSpalte = .Cells(2, .Columns.Count).End(xlToLeft).Column
.Range("C2").Copy
.Range(.Cells(2, 4), .Cells(2, letzteSpalte)).PasteSpecial xlPasteFormats
.Range("B1:B" & loLetzte1).ClearContents
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Gruß Werner

Hallo Werner,
ich muss mich leider nochmal bei dir melden. Ich schaffe es einfach nicht die Formel an meine neuen Bedinungen anzupassen. Dieses mal soll die Spalte für den Sortier und Duplikate entfernen Vorgang A sein, also gleich die erste und die Werte ab B1 beginnen. Simpel dachte ich aber ich verstehe Teile vom Code nicht.


Public Sub Duplikate_Material()
Dim loLetzte As Long
Dim loLetzte1 As Long
Dim letzteSpalte As Long
Application.ScreenUpdating = False
With tbl_UAE01 'Codename (Indexname außerhalb des gültigen Bereichs)
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row 'Anzahl der Zeilen in der ersten Spalte  _
der ersten Tabelle ermitteln
.Range(.Cells(2, 1), .Cells(loLetzte, 1)).Copy _
Sheets("tbl_MatrNr").Range("A1") 'Kopieren der Werte in Spalte 1 ab Zeile 2 und übertragen  _
in Zelle A1 in der zweiten Tabelle
End With
With tbl_MatrNr
'Zwischenspeicherung der Werte, Sortierung
'Spalte muss frei bleiben da ansonsten Werte überschrieben werden!!
.Range("A1:A").RemoveDuplicates Columns:=1, Header:=xlNo 'In der zwischenspalte A werden  _
die Duplikate entfernt
loLetzte1 = .Cells(.Rows.Count, 1).End(xlUp).Row 'Danach wird die neue Anzahl an Zeilen  _
ermittelt
.Sort.SortFields.Clear 'Vorsortierung löschen
.Sort.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'Werte in der  _
zwischenspalte A sortieren
End With
With tbl_MatrNr.Sort '
.SetRange Range("A1:A" & loLetzte1) 'Sortieren mit der neuen Anzahl an Zeilen
.Header = xlNo 'Keine Headerformatierung
.MatchCase = False '?
.Orientation = xlTopToBottom 'Text orientierung
.Apply 'Sortierung anwenden
End With
With tbl_MatrNr
.Range("A1:A" & loLetzte1).Copy 'Kopieren mit neuen Bereich
.Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True 'Einfügen der bearbeitenden Werte ab B1 in transponieren Form
letzteSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Column 'Ermittlung der letzen  _
Spalte (Zeile 1, Ermittlung Spalte)
.Range("B1").Copy
.Range(.Cells(1, 2), .Cells(1, letzteSpalte)).PasteSpecial xlPasteFormats
.Range("A1:A" & loLetzte1).ClearContents
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Zum besseren Verständnis habe ich den Code so gut es geht kommentiert. Spätestens ab den letzten Block verstehe ich nicht ganz die Vorgehensweise
https://www.herber.de/bbs/user/112302.xlsx
Eine Beispiel Tabelle: A1 soll zum Zwischenspeichern des Codes sein und ab B1 die eindeutigen Werte aus der ersten Spalte in der tbl_UAE01.
Vielen lieben Dank für eure Unterstützung
Viele Grüße
Christian

Duplikate entfernen und Werte gleichzeitig sortier

Forumthread: Duplikate entfernen und Werte gleichzeitig sortier

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial