Registriert seit: 17.05.2018
Version(en): 365
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
Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2019 / Arbeit: MS365
Hi Leo,
kannst due eine Beispieldatei hochladen?
LG
Alexandra
Registriert seit: 17.05.2018
Version(en): 365
Hi Alexandra,
anbei ein Beispiel.
Beste Grüße
leo
Angehängte Dateien
Mappe1.xlsx (Größe: 9,83 KB / Downloads: 7)
Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2019 / Arbeit: MS365
Hi Leo,
so!
LG
Alexandra
Angehängte Dateien
Apfel Birnen.xlsm (Größe: 24,03 KB / Downloads: 10)
Registriert seit: 17.05.2018
Version(en): 365
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
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
Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2019 / Arbeit: MS365
Hi Leo,
dann so!
LG
Alexandra
Angehängte Dateien
Apfel Birnen (1).xlsm (Größe: 22,63 KB / Downloads: 2)
Folgende(r) 1 Nutzer sagt Danke an cysu11 für diesen Beitrag: 1 Nutzer sagt Danke an cysu11 für diesen Beitrag 28
• Leonhard