Tabellenkopie; Kopie ohne Duplikate

Forumthread: Tabellenkopie; Kopie ohne Duplikate

21.05.2019 07:14:14

Pascal

Hallo liebes Forum,
ich hatte gestern den Betreff vergessen und versuche es daher einfach nochmal mit meiner Anfrage, hoffe das passt!
https://www.herber.de/bbs/user/129895.xlsx
Diese Datei hat 2 Reiter, Ausgangstabelle & Zieltabelle.
Ich möchte die Ausgangstabelle in die Zieltabelle verwandeln.
Dafür soll immer nur die 1. gefundene Zeile zu einer Nummer in Spalte C (Überschrift 3) übernommen werden.
Kommt diese Nummer ein 2tes, 3tes bis Xtes mal vor soll diese jeweilige Zeile nicht mehr in die Zieltabelle übernommen werden.
Am Ende kommt also jede Nummer in Spalte C (Überschrift 3) nur 1x in der Zieltabelle vor.
Hoffe mit Hilfe der Beispiel-Datei wird es klar.
Liebe Grüße,
Pascal

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Ansatz

21.05.2019 09:08:31

Fennek
AW: Ansatz

21.05.2019 09:22:17

Pascal
AW: Ansatz

21.05.2019 10:14:04

peterk
AW: Ansatz

21.05.2019 10:56:30

Pascal
AW: Ansatz

21.05.2019 15:00:36

Werner

AW: Ansatz

21.05.2019 09:08:31

Fennek

Hallo,
füge in Spalte M (erste freie Spalte) ein:

=ZÄHLENWENN($C$2:C2;C2)

sortiere nach dieser Spalte und kopiere alle Zeilen mit "1" in das Zielblatt.
Wenn es sein muss, kann man dafür auch einen VBA-Code schreiben.
mfg

AW: Ansatz

21.05.2019 09:22:17

Pascal

Ok klappt super, danke dir!
Wie würde denn der VBA-Code dazu aussehen?
Wäre natürlich super mit einer (VBA-Code)Schaltfläche.
mfg

AW: Ansatz

21.05.2019 10:14:04

peterk

Hallo
Ohne Hilfsspalte

Option Explicit

Public Sub Copy2Ziel()

    Dim maxCells As Long
    Dim i As Long
    Dim objDict As Object
    Dim DictKey As Variant

    With Worksheets("Ausgangstabelle")    'Tabellenname anpassen 
        maxCells = .Cells(.Rows.Count, 3).End(xlUp).Row

        Set objDict = CreateObject(Class:="Scripting.Dictionary")
        For i = 2 To maxCells

            If Not objDict.Exists(Key:=.Cells(i, 3).Text) Then
                objDict.Add Key:=.Cells(i, 3).Text, Item:=i
            End If
        Next i
    End With
    
    Application.ScreenUpdating = False
    i = 2
    For Each DictKey In objDict.keys
        Worksheets("Ausgangstabelle").Rows(objDict(DictKey)).Copy Destination:=Worksheets("Zieltabelle").Rows(i)
        i = i + 1
    Next DictKey
    Application.ScreenUpdating = True
    
    Set objDict = Nothing
End Sub


VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0

AW: Ansatz

21.05.2019 10:56:30

Pascal

Danke dir peterk,
hat alles super geklappt!
ich wünsch dir was.
Pascal

AW: Ansatz

21.05.2019 15:00:36

Werner

Hallo,
hier eine Möglichkeit mit RemoveDuplicates

Public Sub aaa()
With Worksheets("Ausgangstabelle")
.Range("A1:L" & .Cells(.Rows.Count, "A").End(xlUp).Row).Copy _
Worksheets("Zieltabelle").Range("A1")
End With
With Worksheets("Zieltabelle")
.Range("$A$1:$L$" & .Cells(.Rows.Count, "A").End(xlUp).Row).RemoveDuplicates _
Columns:=Array(2, 3), Header:=xlYes
End With
End Sub

Gruß Werner

Beliebteste Forumthreads (12 Monate)

Tabellenkopie; Kopie ohne Duplikate

Forumthread: Tabellenkopie; Kopie ohne Duplikate

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread