VBA/VBS: Doppelte Nummern löschen

  • Excel

Es gibt 12 Antworten in diesem Thema. Der letzte Beitrag () ist von Sachsenbauch.

    VBA/VBS: Doppelte Nummern löschen

    Hallo Helfergemeinde,
    aus einer ca. 11000 Datensätze umfassenden Textdatei möchte ich alle Dubletten entfernen.
    Und zwar bestehen einige Zeilen aus einer Nummer oder einer Nummer mit einem nachfolgenden Text. Wie kann ich all jene Dubletten löschen, die nur aus der Nummer bestehen - Datensätze mit Nummer und Text sollen also erhalten bleiben. Ab und zu kann es auch vorkommen daß Datensätze gleich sind d.h. Nummer + Text sind identisch, hier kann ein Satz gelöscht werden.
    Der Trenner zwischen Nummer und dem Text ist ein Semikolon (csv-gerecht). Über eine Lösung in VBS oder VBA würde ich mich sehr freuen.

    Ja,
    da habe ich auch schon gehört, daß ab EXCEL 2007 so eine Funktion vorhanden sein soll. Ich werkel aber noch mit MS Office 2003 herum.
    Außerdem sollen ja nicht ALLE DUBLIKATE entfernt werden, sondern nur jene, die in Spalte 2 leer sind.
    Einen Ansatz fand ich durch Googeln, aber da werden ALLE Zeilen gelöscht - egal ob Dublette oder nicht:

    Quellcode

    1. Sub Gleiche_Loeschen_SpalteB()
    2. Dim i As Long
    3. Dim lngLastR As Long
    4. lngLastR = Cells(Rows.Count, "A").End(xlUp).Row + 1
    5. Do
    6. i = i + 1
    7. Range(Cells(i + 1, "B"), Cells(lngLastR, "B")).Replace _
    8. what:=Cells(i, "B").Value, replacement:="", lookat:=xlWhole
    9. Loop While WorksheetFunction.CountIf(Range(Cells(i + 1, "B"), Cells(lngLastR, "B")), "") < (lngLastR - i)
    10. Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    11. End Sub

    Du kannst auch den Advanced Filter verwenden.
    wikihow.com/Remove-Duplicates-in-Excel

    Falls du mehrere Spalten mappen willst, erzeuge eine temporäre Spalte, in die du alle Keys referenzierst.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „petaod“ ()

    Es funktioniert nicht !
    Excel wertet nur Zeilen gleichen In halts - Trotz gewähltem Kriterienbereichs.
    Hier eine neue Variante:

    Quellcode

    1. Sub Dublettenentfernen()
    2. Dim Zeile As Integer
    3. Dim ZeileMax As Integer
    4. With ActiveSheet '("Testtabelle")
    5. ZeileMax = .Range("A65536").End(xlUp).Row
    6. ' nach Spalte A sortieren ...
    7. .Columns(1).Sort Key1:=Range("A1"), Order1:=xlAscending, Orientation:=xlTopToBottom
    8. For Zeile = ZeileMax To 2 Step -1
    9. If Cells(Zeile, 2).Value = "" Then ' ***
    10. ' Vergleich mit Vorgängerzelle
    11. If Cells(Zeile, 1).Value = .Cells(Zeile - 1, 1).Value Then
    12. .Rows(Zeile).Delete
    13. End If
    14. End If ' ***
    15. Next Zeile
    16. End With
    17. End Sub
    Die "gesternten" Zeilen 9 und 13 wurden von mir eingefügt. Ohne diese wird wiederum jede zweite Zeile gelöscht (ohne Rücksicht ob Spalte B leer ist oder nicht). Egal ob die Zeile auf Zeile 9 oder auf Zeile 13 ist, es geschieht NICHTS. Hast Du denn wirklich keine Lösung parat ?

    PS. Danke für die Anleitung, ist aber wohl ab EXCEL 2007... Click the "Remove duplicates" button in the data toolbar.

    Die Tabelle war ja schon sortiert..

    Quellcode

    1. ...
    2. ' With ActiveSheet '("Testtabelle")
    3. ZeileMax = ActiveSheet.Range("A65536").End(xlUp).Row
    4. ' nach Spalte A sortieren ...
    5. ActiveSheet.UsedRange.Select
    6. With Selection
    7. '' .Sort ...

    bringt auch keine Lösung

    Es klemmt einfach daran, daß die IF-Bedingung

    Quellcode

    1. If Cells(Zeile, 2).Value = "" Then

    wirkungslos ist, d.h. es werden unabängig vom Inhalt der Zelle (Zeile, Spalte B) alle doppelten Zeilen gelöscht, bei denen in Zelle (Zeile, Spalte A) der gleiche Inhalt wie in der Nachbarzelle steht. Ich möchte aber BITTSCHÖN nur die Zeile gelöscht haben, die in Spalte B leer ist. ;(

    Sachsenbauch schrieb:

    ist aber wohl ab EXCEL 2007
    Da sind zwei Methoden beschrieben.
    Du hast natürlich die gelesen, die für dich nicht zutrifft. ;)
    Aber für dein spezifisches Problem hilft das auch nicht weiter, da du ja keine Duplikat-Zeilen löschen willst, sondern Zeilen, in denen Spalte 1 gleich ist und Spalte 2 leer.

    Wie gesagt, der obige Ansatz ist nicht so schlecht.
    Wenn du den aktuellen Code nochmals komplett veröffentlichst, kann man dir evtl. helfen.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    petaod schrieb:

    Wenn du den aktuellen Code nochmals komplett veröffentlichst, kann man dir evtl. helfen.
    ,das würde mich natürlich sehr freuen. Deshalb hier der Gesamtcode

    Visual Basic-Quellcode

    1. Sub Dublettenentfernen()
    2. Dim Zeile As Integer
    3. Dim ZeileMax As Integer
    4. 'With ActiveSheet '("Testtabelle")
    5. ZeileMax = ActiveSheet.Range("A65536").End(xlUp).Row
    6. ' nach Spalte A sortieren ...
    7. ActiveSheet.UsedRange.Select
    8. With Selection
    9. .Sort Key1:=Range("A1"), Order1:=xlAscending, Orientation:=xlTopToBottom
    10. For Zeile = ZeileMax To 2 Step -1
    11. ' Vergleich mit Vorgängerzelle
    12. If Cells(Zeile, 1).Value = .Cells(Zeile - 1, 1).Value Then
    13. If Cells(Zeile, 2).Value = "" Then ' ***
    14. .Rows(Zeile).Delete
    15. End If
    16. End If '***
    17. Next Zeile
    18. End With
    19. End Sub

    Ich nehme mal an, das ist, was du willst:

    Visual Basic-Quellcode

    1. Sub Dublettenentfernen()
    2. Dim r As Long, ws As Worksheet
    3. Set ws = ActiveSheet 'besser per Namen oder Index ansprechen!
    4. ws.UsedRange.Sort Key1:=ws.Range("A1"), Key2:=ws.Range("B2")
    5. For r = ws.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
    6. If ws.Cells(r, 1).Value = ws.Cells(r - 1, 1).Value Then
    7. If ws.Cells(r, 2).Value = "" Then ws.Rows(r).EntireRow.Delete
    8. End If
    9. Next
    10. End Sub
    Falls du nicht nur leere B-Spalten, sondern echte Dubletten (also Spalte A = Spalte B) auch noch ausblenden willst, musst du halt die If-Abfrage in Zeile 7 entsprechend ändern.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --