Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1692to1696
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabellenkopie; Kopie ohne Duplikate

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
Anzeige
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


Anzeige
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

101 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige