Doppelte Einträge mit Bedingung löschen

omar.ab · 2019-01-10T14:53:37+00:00

Guten Tag liebe Community, ist es möglich in einer Excel Tabelle alle Zeilen mit doppeltem Eintrag in Spalte C per Makro zu löschen, jedoch mit der Bedingung dass Zeilen mit dem Wert "xxx" in der Spalte C IGNORIERT werden (sodass nur doppelte Zeilen gelöscht werden die nicht xxx in Spalte c stehen haben) Die Länge der Tabelle beträgt sich ca. auf 6000 Zeilen

Hallo Omar,
teste mal:

Option Explicit

Public Sub DeleteDuplicates()

    Const NO_NAME As String = "xxx"

    Dim objDictionary As Object
    Dim avntValues As Variant
    Dim ialngIndex As Long

    With Worksheets("Tabelle1") 'Name der Tabelle anpassen

        avntValues = .Range(.Cells(1, 3), .Cells(.Rows.Count, 3).End(xlUp)).Value

        Set objDictionary = CreateObject(Class:="Scripting.Dictionary")

        For ialngIndex = UBound(avntValues, 1) To LBound(avntValues, 1) Step -1

            If avntValues(ialngIndex, 1) <> NO_NAME Then

                If objDictionary.Exists(Key:=avntValues(ialngIndex, 1)) Then

                    Call .Rows(ialngIndex).Delete(Shift:=xlShiftUp)

                Else

                    Call objDictionary.Add(Key:=avntValues(ialngIndex, 1), Item:=vbNullString)

                End If
            End If
        Next

        Set objDictionary = Nothing

    End With
End Sub

Der Code gehört in ein Standardmodul. Menleiste im VBA-Editor - Einfügen - Modul.
Gruß
Nepumuk

Hallo Omar,
und hier die Version mit Formel und RemoveDuplicates:

Public Sub Doppelte_raus()
Dim loZeile As Long, loSpalte As Long
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
loZeile = .Cells(.Rows.Count, 3).End(xlUp).Row
loSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1).Column
.Range(.Cells(2, loSpalte), .Cells(loZeile, loSpalte)).FormulaLocal = _
"=WENN(ZÄHLENWENNS(C:C;C2;C:C;""xxx"")>1;0;ZEILE())"
.Range(.Cells(2, loSpalte), .Cells(loZeile, loSpalte)).Value = _
.Range(.Cells(2, loSpalte), .Cells(loZeile, loSpalte)).Value
.Cells(1, loSpalte) = 0
.Range(.Cells(1, 1), .Cells(loZeile, loSpalte)).RemoveDuplicates Columns:=loSpalte, Header:= _
xlNo
.Columns(loSpalte).ClearContents
End With
End Sub

Gruß Werner

Doppelte Einträge mit Bedingung löschen

Forumthread: Doppelte Einträge mit Bedingung löschen

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Doppelte Einträge mit Bedingung löschen

Forumthread: Doppelte Einträge mit Bedingung löschen

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread