3 Spalten ohne Duplikate in neue Spalte per VBA

Forumthread: 3 Spalten ohne Duplikate in neue Spalte per VBA

21.10.2016 10:22:02

Nilo

Hallo alle zusammen,
ich mal wieder mit ner Denkblockade!
Ich habe 3 Tabellen (A,B,C) mit Daten (Zahlen, Text, ZahlenmitText und Mischwerte) in Spalte A
Diese Daten möchte ich ohne Duplikate in Spalte A der Tabelle D übernehmen per VBA.
Eine Tabelle geht ja noch aber alle zusammen in einem Rutsch, da stehe ich gerade aufm Schlauch.
Danke schon einmal für Euren Support.
Gruß
Nilo

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: 3 Spalten ohne Duplikate in neue Spalte per VBA

21.10.2016 11:11:29

Michael

Hallo Nilo!
Unter der Annahme, dass die Tabellenblätter A bis D auch die Reihenfolge 1 bis 4 in der Mappe haben:

Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet, WsZ As Worksheet
Dim Daten As Range, Ziel As Range
Dim i As Long
With Wb
Set WsZ = .Worksheets(4)
For i = 1 To 3
With .Worksheets(i)
Set Daten = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set Ziel = WsZ.Cells(WsZ.Rows.Count, 1).End(xlUp).Offset(1, 0)
Daten.AdvancedFilter Action:=xlFilterCopy, _
copytorange:=Ziel, unique:=True
End With
Next i
End With
End Sub

Passt?
LG
Michael

AW: 3 Spalten ohne Duplikate in neue Spalte per VBA

21.10.2016 11:20:54

Nilo

Moin Michael,
danke schonmal! Die Tabellen sind:
Quelltabellen:
Tabelle5(A)
Tabelle7(B)
Tabelle12(C)
Zieltabelle:
Tabelle3(D)
Gruß

AW: 3 Spalten ohne Duplikate in neue Spalte per VBA

21.10.2016 11:32:36

Michael

Hallo!
Warum nicht gleich mit richtigen Infos?

Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet, WsZ As Worksheet
Dim Daten As Range, Ziel As Range
With Wb
Set WsZ = .Worksheets("Tabelle3") 'Ziel-Tabelle
With .Worksheets("Tabelle5") 'Quell-Tabelle A usw...
Set Daten = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set Ziel = WsZ.Cells(WsZ.Rows.Count, 1).End(xlUp).Offset(1, 0)
Daten.AdvancedFilter Action:=xlFilterCopy, _
copytorange:=Ziel, unique:=True
End With
With .Worksheets("Tabelle7")
Set Daten = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set Ziel = WsZ.Cells(WsZ.Rows.Count, 1).End(xlUp).Offset(1, 0)
Daten.AdvancedFilter Action:=xlFilterCopy, _
copytorange:=Ziel, unique:=True
End With
With .Worksheets("Tabelle12")
Set Daten = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set Ziel = WsZ.Cells(WsZ.Rows.Count, 1).End(xlUp).Offset(1, 0)
Daten.AdvancedFilter Action:=xlFilterCopy, _
copytorange:=Ziel, unique:=True
End With
End With
End Sub

LG
Michael

AW: 3 Spalten ohne Duplikate in neue Spalte per VBA

21.10.2016 11:41:17

Nilo

Hi,
Danke Dir !
Nun ja meine Tabellen heißen A, B ,C, D wie ich es geschrieben habe nicht Tabelle1, Tabelle2, Tabelle3!
Ich dachte wohl das wäre eindeutig!?
;)
Gruß

Dann tausch die Blattnamen aus...

21.10.2016 12:29:21

Michael

Nilo!
So kompliziert zu verstehen ist mein Code jetzt nicht, dass Du das nicht ausprobieren könntest!
Also:

Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet, WsZ As Worksheet
Dim Daten As Range, Ziel As Range
With Wb
Set WsZ = .Worksheets("A") 'Ziel-Tabelle
With .Worksheets("A") 'Quell-Tabelle "A"
Set Daten = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set Ziel = WsZ.Cells(WsZ.Rows.Count, 1).End(xlUp).Offset(1, 0)
Daten.AdvancedFilter Action:=xlFilterCopy, _
copytorange:=Ziel, unique:=True
End With
With .Worksheets("B") 'Quell-Tabelle "B"
Set Daten = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set Ziel = WsZ.Cells(WsZ.Rows.Count, 1).End(xlUp).Offset(1, 0)
Daten.AdvancedFilter Action:=xlFilterCopy, _
copytorange:=Ziel, unique:=True
End With
With .Worksheets("C") 'Quell-Tabelle "C"
Set Daten = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set Ziel = WsZ.Cells(WsZ.Rows.Count, 1).End(xlUp).Offset(1, 0)
Daten.AdvancedFilter Action:=xlFilterCopy, _
copytorange:=Ziel, unique:=True
End With
End With
End Sub

LG
Michael

Oder auch als Schleife mit Blattnamen...

21.10.2016 12:38:32

Michael

Nilo,

Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet, WsZ As Worksheet
Dim arrWbQ, i As Long, Daten As Range, Ziel As Range
arrWbQ = Array("A", "B", "C") 'Gesammelte Quell-Tabellen
With Wb
Set WsZ = .Worksheets("D") 'Ziel-Tabelle
For i = LBound(arrWbQ) To UBound(arrWbQ)
With .Worksheets(arrWbQ(i))
Set Daten = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set Ziel = WsZ.Cells(WsZ.Rows.Count, 1).End(xlUp).Offset(1, 0)
Daten.AdvancedFilter Action:=xlFilterCopy, _
copytorange:=Ziel, unique:=True
End With
Next i
End With
End Sub

Passt? Oder brauchst Du noch was?
LG
Michael

zuletzt filtern?

21.10.2016 14:06:54

KlausF

Hallo Michael,
wäre es nicht besser erst alle Daten auf einem Blatt zu sammeln
und danach den Filter zu setzen? Könnte ja sein, dass es gleiche
Daten auf unterschiedlichen Blättern gibt. Nur mal so als Idee.
Gruß
Klaus

Ja, Klaus, da hast Du sicher recht...

21.10.2016 14:30:06

Michael

...leider aber hat sich Nilo ja mit Informationen zu seinen Gegebenheiten recht "ressourceneffizient" verhalten ;-).
Aber ist sicher eine gute und umsetzenswerte Idee - für mich heute allerdings nicht mehr, also wenn Du Zeit und Lust hast, the stage is yours; ich bin dann mal im Wochenende.
LG und schönes Wochenende!
Michael

AW: sorry für dieses Durcheinander und Danke!

26.10.2016 09:53:34

Nilo

...
nächstes mal etwas mehr Info meinerseits!

Beliebteste Forumthreads (12 Monate)

3 Spalten ohne Duplikate in neue Spalte per VBA

Forumthread: 3 Spalten ohne Duplikate in neue Spalte per VBA

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

3 Spalten ohne Duplikate in neue Spalte per VBA

Forumthread: 3 Spalten ohne Duplikate in neue Spalte per VBA

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread