AW: Datenbank doppelte löschen
30.11.2006 20:53:48
Erich
Hallo Philipp W.,
so ganz klar ist die Fragestellung nicht:
Mit Kommentar meinst du wohl einen Wert (z.B. Text) in Spalte 6, nicht den Excel-Kommentar.
Bedeutet "wenn aber in der Spalte 5 was drin steht"
- wenn in Spalte 5 ein nichtleerer Wert drinsteht? (Davon geht unten der Code aus.)
- wenn in Spalte 5 etwas drinsteht (kann auch eine Formel mit Wert "" sein)
Was soll geschehen, wenn in mehreren ansonsten gleiche Datensätzen in Spalte 5 Werte stehen?
Sollen dann alle Dubletten mit Spalte-5-Texten stehen bleiben?
Probiers mal mit
Option Explicit
Sub DoppelteZeilenLoeschen_bedingt()
Dim lngL As Long, zz As Long, sp As Integer
Const bolGrKl As Boolean = False ' Groß-/Kleinschr. berücksichtigen?
lngL = Cells(Rows.Count, 1).End(xlUp).Row ' letzte Zeile
With Range("F1:F" & lngL)
.FormulaR1C1 = "=ROW()" ' Zeilennummern
.Value = .Value ' als Werte
End With
With Range("A1:F" & lngL) ' Sort (Spalte 5 abst.)
.Sort _
Key1:=Range("D2"), Order1:=xlAscending, _
Key2:=Range("E2"), Order2:=xlDescending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=bolGrKl, Orientation:=xlTopToBottom
.Sort _
Key1:=Range("A2"), Order1:=xlAscending, _
Key2:=Range("B2"), Order2:=xlAscending, _
Key3:=Range("C2"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=bolGrKl, Orientation:=xlTopToBottom
End With
For zz = lngL To 2 Step -1 ' prüfen und löschen
For sp = 1 To 4
If bolGrKl Then
If Cells(zz, sp) <> Cells(zz - 1, sp) Then Exit For
Else
If UCase(Cells(zz, sp)) <> UCase(Cells(zz - 1, sp)) Then Exit For
End If
Next sp
If sp > 4 And Cells(zz, 5) = "" Then Rows(zz).Delete
Next zz
' Sort nach Zeilennr.
Range("A1:F" & lngL).Sort _
Key1:=Range("F2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns("F:F").Delete ' Zeilennr. löschen
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort