Unikate aus Tabelle in eine neue Spalte

[l5w6ed]

Hallo zusammen,
brüte gerade über einem Problem: Habe eine Tabelle mit mehreren Spalten. In allen Spalten (Zellen) befinden sich Namen. Aus der gesamten Tabelle hätte ich nun gerne jeden Namen nur einmal.
Die Funktion "Duplikate löschen" klappt nur mit einer Spalte. Beim Spezialfilter hat er immer nach gleichen Zeilen gesucht, anstatt jede Zelle für sich zu vergleichen.
Kann jemand helfen? Meine Internetsuche war bisher erfolglos

Gruß
Volker

[Jonas0806]

Hallo Volker,

Die Funktion "Duplikate löschen" klappt nur mit einer Spalte.

Wie kommst Du darauf?

Lade bitte eine Beispieldatei hoch.

[Wastl]

Hi,

kopiere doch alle Spalten in eine einzige, dann kannste mit Duplicate löschen arbeiten…

Gruß Wastl

[l5w6ed]

Hi,

kopiere doch alle Spalten in eine einzige, dann kannste mit Duplicate löschen arbeiten…

Gruß Wastl

Ist ne große Tabelle mit vielen Spalten. Das würde zu lange dauern. :17:

[l5w6ed]

Hallo Volker,

Wie kommst Du darauf?

Lade bitte eine Beispieldatei hoch.

So in etwa 

[Wastl]

Hi,

dann hab ich eine VBAschnipsel in meinem Fundus:

Private Sub KeineDublikate()
Dim rngBereich As Range
Dim rngZelle As Range
Dim NoDups As New Collection
Dim Item As Variant
Dim vx(1 To 1048576, 1 To 1) As Variant
Dim I As Long

  'Bei Fehler weitermachen
  'Fehler tritt bei schon vorhandenem 'Key' in der Collection auf
  On Error Resume Next

  For Each rngBereich In Selection.Areas
    For Each rngZelle In rngBereich
      'Key = CStr(rngZelle.Value) muß einmalig sein, sonst Fehler
      'That's the trick!
      NoDups.Add rngZelle.Value, CStr(rngZelle.Value)
    Next
  Next

  'neues Blatt anlegen
  Sheets.Add Before:=Sheets(1)
  Columns(1).NumberFormat = "@"

  'jedes einmalige Element der Collection ausgeben
  For Each Item In NoDups
    I = I + 1
    vx(I, 1) = Item
'    ActiveCell.Offset(1, 0).Select
  Next
With ActiveSheet
    .Range(.Cells(1, 1), .Cells(I, 1)) = vx
End With
End Sub

[Fennek]

Hallo,

im Code steht

Code:

Dim vx(1 To 1048576, 1 To 1) As Variant

Besser ist es nur den nötigen Bereich zu übergeben

Code:

Ar = Range("A1:F12")

mfg

[Jonas0806]

Hallo,

da habe ich das Problem wohl falsch interpretiert. Hier eine Formellösung:

PHP-Code:

=INDEX($A$2:$F$9;WENN(REST(ZEILE(A1);7);REST(ZEILE(A1);7);8);AUFRUNDEN(ZEILE(A1)/8;)) 


Danach dann die Formel als Werte einfügen und normal Duplikate entfernen.

[Wastl]

Hi Fennek,

du hast sicherlich erkannt, das die von dir zitierte Zeile nur die Ausgabe dimensioniert.
der Eingabebereich wird zuvor von Hand mit der Maus oder sonstwie als ein zusammenhängender Bereich markiert, dann das Makro gestartet.
Das Ergebnis steht in einer neuen Tabelle, die vor dem aktuellen Blatt erzeugt wird.

[snb]

Code:

Sub M_snb()
   With Cells(1).CurrentRegion.Offset(1)
      For j = 1 To .Columns.Count
        .Columns(j).AdvancedFilter 2, , Cells(Rows.Count, 8).End(xlUp).Offset(1), True
      Next
    End With
    Columns(8).AdvancedFilter 2, , Cells(1, 10), True
    Columns(8).Delete
End Sub

oder

Code:

Sub M_snb()
   sn = Cells(1).CurrentRegion.Offset(1).specialcells(2)
  
   For Each it In sn
     If InStr(c00 & "|", "|" & it & "|") = 0 Then c00 = c00 & "|" & it
   Next
   st = Split(Mid(c00, 2), "|")
   Cells(2, 8).Resize(UBound(st) + 1) = Application.Transpose(st)
End Sub