EXCEL Duplikate in Spalte O finden und in anderer Spalte auflisten

Question

Hallo ihr fleißigen Helfer!

Ich bräuchte mal wieder eure Hilfe.

Ich habe in Spalte O von O2 bis O 2006 Rechnungsnummern stehen.

Diese Spalte O soll nach Duplikaten abgesucht werden und wenn Duplikate gefunden werden, sollen diese dann in Spalte Q aufgelistet werden.

Allerdings tatsächlich nur die Duplikate und keine Zelle ohne Duplikat. Das heißt, wenn drei Duplikate gefunden werden, sollen dann auch nur diese drei Duplikate in Spalte Q von oben (Q2) direkt untereinander gelistet sein (also in Q2,Q3 und Q4 stehen).

Ich wäre sehr glücklich, wenn es dafür eine Lösung gäbe.

Beste Grüße

Hans-Jörg

Answer 1

Worksheets(1) - Anpassen

Sub DoppelteFiltern()
    Dim DoppelteFalse As Object
    Worksheets(1).Range("Q2:Q" & Worksheets(1).Cells(Rows.Count, 15).End(xlUp).Row + 1).Clear
    Worksheets(1).Range("O:O").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Set DoppelteFalse = Worksheets(1).Range("O:O").SpecialCells(xlCellTypeVisible)
    Worksheets(1).Range("O:O").AdvancedFilter Action:=xlFilterInPlace, Unique:=False
    DoppelteFalse.Rows.Hidden = True
    Worksheets(1).Range("O:O").SpecialCells(xlCellTypeVisible).Copy Worksheets(1).Range("Q2")
    DoppelteFalse.Rows.Hidden = False
End Sub

Answer 2

Hi Hans-Jörg,

vielleicht hilft dir die Formellösung in diesem Link weiter: https://www.herber.de/excelformeln/pages/Formelloesungen_fuer_Spezialfilter_ohne_Duplikate.html

Bis später, Karin

Answer 3

Hallo Jan, Hallo Karin!
Vielen Dank für Eure Mühe und Eure Antworten. Hatte leider noch keine Zeit sie zu testen, da ich im Urlaub bin. Sobald ich wieder zu Hause bin., werde ich mich sofort ans Austesten machen und gebe Euch Bescheid.

Nochmal vielen Dank
Beste Grüße
Hans-Jörg

Answer 4

Hallo Jan,

Deine Lösung funktioniert super.

Ist es vielleicht noch möglich, dass die gefundenen Duplikate in Spalte Q direkt untereinander stehen, ich meine, dass die Zellen in Spalte Q, in denen kein Duplikat steht, also leer sind, nicht erscheinen?

Beste Grüße

und nochmal vielen Dank an Dich und Karin

Hans-Jörg

Answer 5

Es lassen sich nur Zeilen oder ganze Spalten ausblenden aber keine Zellen !

Answer 6

Okay,

dann nochmal vielen Dank für Eure Hilfe!

Beste Grüße

Hans-Jörg

Answer 7

Noch eine andere Variante!

Hyperlink der Zelle in Spalte Q springt zum Fundort in Spalte O

Sub DoppelteFiltern3()
    Dim ws As Worksheet, u As Range, v As Range, c As Range, r As Long, lastRow As Long
    Set ws = Worksheets(1): r = 2
    lastRow = ws.Cells(ws.Rows.Count, "O").End(xlUp).Row
    ws.Range("Q2:Q" & ws.Rows.Count).Clear
    ws.Range("O1:O" & lastRow).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    On Error Resume Next
    Set u = ws.Range("O1:O" & lastRow).SpecialCells(xlCellTypeVisible): On Error GoTo 0
    ws.Range("O1:O" & lastRow).AdvancedFilter Action:=xlFilterInPlace, Unique:=False
    If Not u Is Nothing Then u.EntireRow.Hidden = True
    On Error Resume Next
    Set v = ws.Range("O2:O" & lastRow).SpecialCells(xlCellTypeVisible): On Error GoTo 0
    If Not v Is Nothing Then
        For Each c In v.Cells
            If Len(c.Value) > 0 Then
                ws.Cells(r, "Q").Formula = "=HYPERLINK(""#'" & ws.Name & "'!O" & c.Row & """,""" & _
                  Replace(CStr(c.Value), """", """""") & " - Zeile " & c.Row & """)"
                r = r + 1
            End If
        Next c
    End If
    If Not u Is Nothing Then u.EntireRow.Hidden = False
    On Error Resume Next: ws.ShowAllData: On Error GoTo 0
End Sub

Answer 8

Hallo anonym!

Das ist echt super.

Genau so hab ich mir das vorgestellt.

Allerdings werden auch die Zellen mit dem Wert 0 in Spalte Q übernommen.

Wäre es vielleicht noch möglich, dass die Zellen in Spalte O ( die Zellen sind alle verknüpft mit Spalte M, also in Zelle O2 steht =M2, in Zelle O3 steht =M3, in Zelle O4 steht =M4 usw.) die den Wert 0 enthalten, nicht in Spalte Q erscheinen, also nur Zellen, die größer als 0 sind?

Vielen Dank für die wirklich große Mühe

Beste Grüße

Hans-Jörg

Answer 9

Hallo Hans

Null Werte ausgeschlossen !

Sub DoppelteFiltern4()
    Dim ws As Worksheet
    Dim u As Range
    Dim v As Range
    Dim c As Range
    Dim r As Long
    Dim lastRow As Long
    Set ws = Worksheets(1)
    r = 2
    lastRow = ws.Cells(ws.Rows.Count, "O").End(xlUp).Row
    ws.Range("Q2:Q" & ws.Rows.Count).ClearContents
    ws.Range("O1:O" & lastRow).AdvancedFilter _
        Action:=xlFilterInPlace, _
        Unique:=True
    On Error Resume Next
    Set u = ws.Range("O1:O" & lastRow).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    ws.Range("O1:O" & lastRow).AdvancedFilter _
        Action:=xlFilterInPlace, _
        Unique:=False
    If Not u Is Nothing Then
        u.EntireRow.Hidden = True
    End If
    On Error Resume Next
    Set v = ws.Range("O2:O" & lastRow).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not v Is Nothing Then
        For Each c In v.Cells
            If Len(c.Value) > 0 And c.Value <> 0 Then
                ws.Cells(r, "Q").Formula = _
                    "=HYPERLINK(""#'" & ws.Name & "'!O" & c.Row & """,""" & _
                    Replace(CStr(c.Value), """", """""") & _
                    " - Zeile " & c.Row & """)"
                r = r + 1
            End If
        Next c
    End If
    If Not u Is Nothing Then
        u.EntireRow.Hidden = False
    End If
    On Error Resume Next
    ws.ShowAllData
    On Error GoTo 0
End Sub

Answer 10

Hallo Anonym!

Was eine Arbeit!

Vielen herzlichen Dank für Deine Mühe, perfekt!

Beste Grüße

Hans-Jörg