gleiche Abteilungsnummer, unterschiedlicher Name

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub aaa() Dim rngDel As Range, rngC As Range Application.ScreenUpdating = False For Each rngC In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)) If Application.CountIf(Columns(1), rngC) = 1 Then If rngDel Is Nothing Then Set rngDel = rngC Else Set rngDel = Union(rngDel, rngC) End If End If Next If Not rngDel Is Nothing Then For Each rngC In rngDel.Areas rngC.Resize(, 2).Delete Next End If End Sub

Hallo Jenkins,
das mit dem Löschen hab ich aber in der ersten Frage nicht gelesen :-(
Ich bleib trotzdem mal bei meinem Vorschlag und hab hier die korrekte Fehlerbehandlung. Die Nummer bekommst Du auch raus, wenn Du sas On Error ... erst mal auskommentierst und Dir dann die Meldung anschaust. Hinterher musst Du den Fehler zurücksetzen, sonst bleibt er, auch wenn die nächste Zeile korrekt wäre.
Wenn Du die Zeilen in einer Schleife löschst, dann solltest Du von hinten anfangen - hinten wäre hier:
Cells(Rows.Count, 1).End(xlUp)) - siehe Rudi's code.
For i=Cells(Rows.Count, 1).End(xlUp)) to 2 step -2
Machst Du es anders rum, wird nur jede zweite Zeile betrachtet. Du löschst z.B. Zeile 9, in dem Moment rutscht Zeie 10 in die 9. Am Schleifenende wird der Zähler auf 10 gestellt, und dort ist ja jetzt die vorherige 11. Die hochgerutschte 10 fällt also durch's Raster :-(

Sub test()
Dim colZeilen As New Collection
'bei Fehler weiter mit naechster Zeile 
'On Error Resume Next 
'Schleife ueber alle Zeilen 
Sheets("Tabelle1").Select
For i = 2 To 100
'Datensatz hinzufuegen. Bei gleichem Key kommt Fehler 
colZeilen.Add i, Sheets("Tabelle1").Cells(i, 1) & Sheets("Tabelle1").Cells(i, 2)
If Err = 457 Then
ActiveSheet.Cells(i, 1).Select
Selection.EntireRow.Delete
Err.Clear
End If
Next

End Sub

Grüße, André

Hallo Jenkins,
sorry, da waren nun beim einfachen aufschreiben gleich 2 Fehler drin.
Mit dem fehlenden .Row hast Du richtig erkannt. Die Steps dürfen allerdings auch nur -1 sein.
Der Fehler 457 sollte nur dann ausgegeben werden, wenn der key schon vorhanden ist, also in dem Fall der zusammengesetzte String aus den beiden Zellen.
Wenn Du die Schleife damit von hinten durchgehst, dann bleibt, wie Du festgestellt hast, immer die letzte Zeile eines Keys erhalten und alle vorhergehenden werden gelöscht.
Ich hatte ja schon mal geschrieben, dass am Anfang das Thema Löschen nicht stand. Dann hatte ich vermutet, dass die Mehrfacheinträge auf einen reduziert werden sollen - und nun sollen alle Zeilen raus, die mehrfach vorkommen.
Rudis Ansatz ist da schon besser. Du musst dort nur statt = 1 größer 1 programmieren, ansonsten werden alle Datensätze gelöscht, die nur 1x vorkommen - und das sind ja die richtigen, hoffe ich jedenfalls.
In Rudis code werden in der Schleife alle Zeilen gesammelt, die in Spalte A mehrfach vorkommen. Die Prüfung ist ja klar, und das Sammeln geschieht in der Zeile mit dem union.
Zum Schluss werden die gesammelten Zeilen gelöscht.
Grüße, André

Beliebteste Forumthreads (12 Monate)

gleiche Abteilungsnummer, unterschiedlicher Name

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread