Leere Zeilen löschen
27.02.2004 11:01:04
Student2000
Ich zähle die Anzahl der Zeilen (Felder) die leer sind. Sobald er auf eine Zeile mit Inhalt trifft, guckt er nach wieviele Leerzeilen er gefunden hat. Sollten es weniger denn 6 sein werden diese gelöscht, indem die Startzeile um die Anzahl der Leerzeilen zurückgesetzt wird. Die Leerzeilen wandern nach oben, so das die Startzeile = Startzeile bleiben kann. Ist das geschehen gehts normal weiter.
Code:
Sub EinzelZeilenEntfernen()
Dim StartZeile, LetzteZeile, LaufZeile, AnzahlLeerZellen, LeerZeile, i As Integer
LetzteZeile = Worksheets("Tabelle3").Cells.Find(What:="*", _
After:=Worksheets("Tabelle3").Range("A1"), _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
StartZeile = 1
AnzahlLeerZellen = 0
Do While StartZeile < LetzteZeile
If Worksheets("Tabelle3").Cells(StartZeile, 1).Value = "" Then
AnzahlLeerZellen = AnzahlLeerZellen + 1
StartZeile = StartZeile + 1
MsgBox "1.: " & StartZeile
MsgBox "2.: " & AnzahlLeerZellen
Else
i = 0
If AnzahlLeerZellen > 0 & AnzahlLeerZellen < 6 Then
LeerZeile = StartZeile - AnzahlLeerZellen + 1
Do While i < AnzahlLeerZellen
Worksheets("Tabelle3").Cells(LeerZeile, 1).Delete
i = i + 1
AnzahlLeerZellen = 0
Loop
StartZeile = StartZeile + 1
Else
If AnzahlLeerZellen = 0 Then
StartZeile = StartZeile + 1
Else
AnzahlLeerZellen = AnzahlLeerZellen
End If
End If
End If
Loop
Application.ScreenUpdating = True
End Sub
mfg thomas