Doppelte Löschen (auch bei Nullen)
Peter
Mit nachfolgendem Code lösche ich doppelte Wert in einem Range.
Nun hat es auch viele Nullen, von denen eigentlich eine bleibern sollte. Was muss ich an meinem Code anpassen, dass eine NULL bleibt?
Danke und Gruss, Peter
Sub Doppelte_Loeschen()
Dim Z1 As Long, Z2 As Long, SP As Long, c As Range, Ende As Long, lngSpa As Long, bereich As _
Range
Z1 = Range("psaBeginn").Row
Z2 = Range("psaEnde").Row
SP = Range("psaBeginn").Column
'--- Hilfsspalten einfügen und Original-Reihenfolge sichern
Sheets("Auswertung").Range("A:B").Insert
With Sheets("Auswertung").Range(Cells(Z1, 1), Cells(Z2, 1))
.FormulaR1C1 = "=Row()"
.Formula = .Value
End With
'--- Doppelte kennzeichnen und löschen
On Error Resume Next
With Sheets("Auswertung").Range(Cells(Z1, 2), Cells(Z2, 2))
.EntireRow.Sort Key1:=Cells(Z1, SP + 2), Order1:=xlAscending, Header:=xlNo
.FormulaR1C1 = "=IF(RC[" & SP & "]=R[-1]C[" & SP & "],TRUE,RC[-1])"
.Formula = .Value
.EntireRow.Sort Key1:=Cells(Z1, 2), Order1:=xlAscending, Header:=xlNo
.SpecialCells(xlCellTypeConstants, 4).EntireRow.Delete
End With
On Error GoTo 0
End Sub
Anzeige