Clever-Excel-Forum

Normale Version: duplikate entfernen und sortieren
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Hallo zusammen,

ich habe mit Hilfe des Makro Recorders 4 Spalten aus Tabelle1 (B5:E ) in Tabelle 2 (N2:Q ) kopiert. Dort habe ich die Duplikate der kopierten Spalten einzeln (ohne Erweiterung, ich will nur die eindeutigen Ergebnisse pro Spalte) entfernt und sortiert. Die Lösung läuft einwandfrei, ist auch zeitlich kein großer Akt. Jedoch ist die Datei knapp 10 mb groß... ich vermute mal das liegt an den vielen Selects die der Recorder einbaut?
Falls ja, wie könnte man das schlanker umsetzen?

Beste Grüße
Leo
Hi Leo,

kannst due eine Beispieldatei hochladen?

LG
Alexandra
Hi Alexandra,

anbei ein Beispiel.

Beste Grüße
leo
Hi Leo,

so!

LG
Alexandra
Hi,

also in deiner Mappe läuft dein Code einwandfrei.
Dein Sheets(2) heißt bei mir weitere_Services
Sheets(1) heißt Input.

Wenn ich deinen Code dahingehend ändere wird mir angezeigt das lz nicht definiert ist Confused

Code:
Sub Dupliate_entfernen()
Call Kopieren
'SpalteN
lz = Sheets("weitere_Services").Cells(Rows.Count, 14).End(xlUp).Row
Sheets("weitere_Services").Range("N2:N" & lz).RemoveDuplicates Columns:=1, Header:=xlNo
Sheets("weitere_Services").Range("N2:N" & lz).Sort Key1:=Range("N1"), Order1:=xlAscending, _
              Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
              Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'SpalteO
lz = Sheets("weitere_Services").Cells(Rows.Count, 15).End(xlUp).Row
Sheets("weitere_Services").Range("O2:O" & lz).RemoveDuplicates Columns:=1, Header:=xlNo
Sheets("weitere_Services").Range("O2:O" & lz).Sort Key1:=Range("O1"), Order1:=xlAscending, _
              Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
              Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'SpalteP
lz = Sheets("weitere_Services").Cells(Rows.Count, 16).End(xlUp).Row
Sheets("weitere_Services").Range("P2:P" & lz).RemoveDuplicates Columns:=1, Header:=xlNo
Sheets("weitere_Services").Range("P2:P" & lz).Sort Key1:=Range("P1"), Order1:=xlAscending, _
              Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
              Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'SpalteQ
lz = Sheets("weitere_Services").Cells(Rows.Count, 17).End(xlUp).Row
Sheets("weitere_Services").Range("Q2:Q" & lz).RemoveDuplicates Columns:=1, Header:=xlNo
Sheets("weitere_Services").Range("Q2:Q" & lz).Sort Key1:=Range("Q1"), Order1:=xlAscending, _
              Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
              Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End Sub

Sub Kopieren()
Set ziel = Sheets("weitere_Services").Range("N2").CurrentRegion
ziel.ClearContents
Set Bereich = Sheets("Input").Range("B5").CurrentRegion
Bereich.Offset(1, 0).Resize(Bereich.Rows.Count - 1, Bereich.Columns.Count).Copy _
Destination:=Sheets("weitere_Services").Range("N2")

End Sub
Hi Leo,

dann so!

LG
Alexandra