Unikate aus 2 Spalten

Forumthread: Unikate aus 2 Spalten

22.03.2020 09:28:54

Fred

Hallo Excel-Profis,
ich möchte eine "Unikatliste" aus Werten von 2 Spalten erstellen.
Die 2 Spalten befinden sich in "Tabelle0", Spalte "BF" & "BG"
Die "Unikatliste" soll in "Tabelle1", ab i2 erstellt werden.
mein code ist in dieser Hinsicht falsch:

Sheets("Tabelle0").Range("BF1:BG100").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Tabelle1").Range("I1"), Unique:=True
Sheets("Tabelle1").Range("I1").Value = "Team"

Kann mir bitte jemand den Code korrigieren?
Gruß
Fred

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Unikate aus 2 Spalten

22.03.2020 12:06:57

Nepumuk
AW: Unikate aus 2 Spalten

22.03.2020 12:36:31

Fred
AW: Unikate aus 2 Spalten

22.03.2020 12:33:50

fcs

AW: Unikate aus 2 Spalten

22.03.2020 12:06:57

Nepumuk

Hallo Fred,
ich denke das funktioniert mit zwei Spalten nicht.
Versuch es mal so:

Option Explicit

Public Sub Unikate()
    Dim avntValues As Variant, vntItem As Variant
    Dim objDictionary As Object
    With Worksheets("Tabelle0")
        avntValues = .Range("BF1:BG100").Value
    End With
    Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
    With objDictionary
        For Each vntItem In avntValues
            .Item(Key:=vntItem) = vbNullString
        Next
        Worksheets("Tabelle1").Cells(2, 9).Resize(.Count, 1).Value = Application.Transpose(.Keys)
        Worksheets("Tabelle1").Cells(1, 9).Value = "Team"
    End With
    Set objDictionary = Nothing
End Sub

Gruß
Nepumuk

AW: Unikate aus 2 Spalten

22.03.2020 12:36:31

Fred

Hallo Nepumuk,
es funzt.
Großer Sport !!
Danke!
Gruß
Fred

AW: Unikate aus 2 Spalten

22.03.2020 12:33:50

fcs

Hallo Fred,
mit dem SPezialfilter kann man nicht die Daten aus 2 Spalten in eine Spalte filtern und in einem anderen Zellbereich ausgeben.
Hier eine Variante:
Die Daten aus den Spalten werden untereinander in die Zielspalte kopiert und dann die Duplikate und Leerzellen gelöscht.
LG
Franz

Sub Unikate_Teams()
' Unikate_Teams Makro
Dim rngZiel As Range
Set rngZiel = Worksheets("Tabelle1").Range("I1")
rngZiel.Value = "Team"
With Worksheets("Tabelle0")
.Range("BF1:BF100").Copy 'ggf. BF1 durch BF2 ersetzen
rngZiel.Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.Range("BG1:BG100").Copy 'ggf. BG1 durch BG2 ersetzen
rngZiel.Offset(101, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
With Worksheets("Tabelle1")
With .Range(rngZiel, rngZiel.Offset(200, 0))
.RemoveDuplicates Columns:=1, Header:=xlYes
.SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp
End With
Range("I1").Select
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Forumthread: Unikate aus 2 Spalten

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread