Option Explicit
Sub LeerzeilenLoeschen()
Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Sub DoppelteMarkieren()
Dim i As Long
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
If Application.CountIf(Range(Cells(2, "B"), Cells(i, "B")), Cells(i, "B")) > 1 Then _
Cells(i, "B").Interior.ColorIndex = 3
Next
End Sub
Sub DoppelteLoeschen()
Dim i As Long
For i = Cells(Rows.Count, "B").End(xlUp).Row To 2 Step -1
If Cells(i, "B").Interior.ColorIndex = 3 Then _
Cells(i, "B").EntireRow.Delete
Next
End Sub
Gruß Jürgen
Und das jetzt in ein Modul? Und dann laufen die alle nacheinander ab?
Ja die Subs kommen in ein Modul
Backowe
Hi Tim,
so wie es momentan geschrieben ist, müssen die 3 Subs nacheinander gestartet werden, um Deinen Anforderungen bzgl. Löschen gerecht zu werden, kann man auch 2 Subs daraus machen. Du wolltest doch eine Eingriffmöglichkeit haben, bevor die Zeilen mit doppeltem Inhalt gelöscht werden, die Zellen werden rot eingefärbt.
| VBA-Code: | Option Explicit
Sub LeerzeilenLoeschenUndDoppelteMarkieren()
Dim i As Long
If Application.CountBlank(Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)) > 0 Then _
Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
If Application.CountIf(Range(Cells(2, "B"), Cells(i, "B")), Cells(i, "B")) > 1 Then _
Cells(i, "B").Interior.ColorIndex = 3
Next
End Sub
Sub DoppelteLoeschen()
Dim i As Long
Application.ScreenUpdating = False
For i = Cells(Rows.Count, "B").End(xlUp).Row To 2 Step -1
If Cells(i, "B").Interior.ColorIndex = 3 Then _
Cells(i, "B").EntireRow.Delete
Next
Application.ScreenUpdating = True
End Sub
Gruß Jürgen
AW: Ja die Subs kommen in ein Modul
Tim
Hallo Jürgen,
ja, super. Habe die ersten beiden jetzt mit main verbunden und dann start ich das löschen manuell. Super. So wollte ich es haben. Vielen Dank!
|
|