AW: Super Klasse Thorsten !
04.06.2010 14:57:53
Oberschlumpf
Hi
Zuerst:
ändere diese Zeilen
Set lrgRow = .Range("B" & lloRow & ":AY" & lloRow)
If Application.WorksheetFunction.CountIf(lrgRow, "") = 49 Then
um in
Set lrgRow = .Range("B" & lloRow & ":AO" & lloRow)
If Application.WorksheetFunction.CountIf(lrgRow, "") = 39 Then
Der Codewechsel deswegen, weil nicht der Bereich B:AY sondern nur der Bereich B:AO geprüft werden muss.
Die Zahl 39 (vorher 49) ergibt sich aus der Anzahl leerer Zellen im Bereich B:AO.
Oder anders:
Bereich B:AO = Bereich 2:41
Die Differenz aus (Spalte) 41 - (Spalte) 2 ergibt 39.
Jetzt mein weiterer Erklärungsversuch:
Sub sbDelTwin()
Dim lloRow As Long, lrgRow As Range
'alles was zwischen With.. und End With steht, bezieht sich
'in diesem Fall auf Sheets(1) = das erste Tabellenblatt in der Datei
With Sheets(1)
'mit For... wird ein Schleifendurchlauf gestartet
'der Code Cells(Rows.Count, 1).End(xlUp).Row gibt als Start
'die in Spalte 1 (A) zuletztgenutzte Zeile zurück
'in deiner Bsp-Datei ist es die Zeile 312
'wenn du jetzt noch z Bsp 10 Zeilen mit Daten hinzufügen würdest,
'dann würde Cells(Rows.Count, 1).End(xlUp).Row als Startwert
'die Zeile 322 zurückgeben - also eben, wie gesagt, die zuletzt benutzte Zeile
'wenn du wissen willst, welche letzte Zeile in Spalte B benutzt wird,
'musst du den Code Cells(Rows.Count, 2).End(xlUp).Row verwenden
For lloRow = .Cells(Rows.Count, 1).End(xlUp).Row To 4 Step -1
'mit If... erfolgt ein Vergleich
'wenn der Wert der aktuell geprüften Zelle mit dem Wert
'der Zelle eine Zeile darüber gleich ist, dann...
If .Range("B" & lloRow).Value = .Range("B" & lloRow - 1).Value Then
'Vorbereitung für nächsten Vergleich
Set lrgRow = .Range("B" & lloRow & ":AO" & lloRow)
'...wenn die Anzahl der leeren Zellen = 39 ist, dann
If Application.WorksheetFunction.CountIf(lrgRow, "") = 39 Then
'lösche die aktuell geprüfte Zeile
'an dieser Stelle ist sicher, dass zwei gleich-
'lautende Zeilen keinen Eintrag haben, und
'es wird eine der zwei Zeilen, wie gewünscht, gelöscht
.Rows(lloRow & ":" & lloRow).Delete Shift:=xlUp
Else
'Else heisst in diesem Fall:
'...wenn die Anzahl der leeren Zellen NICHT! 39 ist, dann
'hat der Code zwei Zeilen gefunden, die zwar in Spalte B
'den selben Wert haben, aber in einer der beiden Zeilen
'existiert auch in Spalte AO ein Wert
'und in diesem Fall soll ja die Zeile gelöscht werden, die in
'Spalte AO keinen Eintrag hat
.Rows(lloRow - 1 & ":" & lloRow - 1).Delete Shift:=xlUp
End If
End If
Next
End With
Set lrgRow = Nothing
End Sub
Hilfts?
Ciao
Thorsten