Option Explicit
Sub BedLoesch()
Dim arrW, zz As Long, rngDel As Range
arrW = Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row, 10)
For zz = 1 To UBound(arrW)
If IsDate(arrW(zz, 1)) Then
If arrW(zz, 4) & arrW(zz, 6) & arrW(zz, 7) & arrW(zz, 10) = "" Then
If rngDel Is Nothing Then
Set rngDel = Cells(zz, 1)
Else
Set rngDel = Union(rngDel, Cells(zz, 1))
End If
End If
End If
Next zz
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End Sub
Sub BedLoesch()
Dim zz As Long, rngDel As Range, arrW As Variant
' arrW dient zur Aufnahme der Werte im Bereich A1:Znnn,
' wobei nnn die letzte in SPalte A belegte Zeile ist
' Abgeprüft werden die Werte des Arrays arrW.
' Das geht schneller, als die Zellen in der Tabelle zu prüfen.
arrW = Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row, 10)
' zz ist der Zeilenzähler,
' von Zeile 1 bis zur letzten Zeile in Sp. A (obere Grenze von arrW)
For zz = 1 To UBound(arrW)
If IsDate(arrW(zz, 1)) Then ' Wert aus Spalte A soll Datum sein
' Werte aus Sp. D,F,G,J zusammen leer?
If arrW(zz, 4) & arrW(zz, 6) & arrW(zz, 7) & arrW(zz, 10) = "" Then
' rngDel nimmt je 1 Zelle (aus Spalte A) der zu löschenden Zeile auf
If rngDel Is Nothing Then
Set rngDel = Cells(zz, 1) ' erste zu löschende Zelle
Else
Set rngDel = Union(rngDel, Cells(zz, 1)) ' weitere zu löschende Zelle
End If
End If
End If
Next zz
' wenn rngDel nicht "Nichts" ist, lösche den Bereich,
' mit jeweils der gesamten Zeile
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End Sub
Sub Yv()
Dim Zeile As Long
For Zeile = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
If IsDate(Cells(Zeile, 4)) Then ' da fehlte das "Cells("
If Cells(Zeile, 4) & Cells(Zeile, 6) & Cells(Zeile, 8) & Cells(Zeile, 10) = "" Then
Rows(Zeile).Delete ' ist einfacher und klarer
' statt Cells(Zeile, 4).EntireRow.Delete
End If
End If
Next Zeile
End Sub
Sub Loeschen()
Dim iCalc As Integer
With Application
iCalc = .Calculation
.ScreenUpdating = False
.Calculation = xlCalculationManual 'Berechnung auf manuell (wichtig)
With Tabelle1.UsedRange 'Tabelle1 Benutzter Bereich
With .Columns(.Columns.Count).Offset(0, 1) 'nächste nicht benutzte Spalte
'Hilfsformel
.FormulaR1C1 = _
"=IF(OR(NOT(ISNUMBER(RC1)),(RC4<>""""),(RC5<>""""),(RC6<>""""),(RC10<>"""")),ROW(),TRUE)"
'Tabelle Sortieren
With Tabelle1.UsedRange
.Sort key1:=.Cells(1, .Columns.Count), Order1:=xlAscending
End With
On Error Resume Next
'Zeilen mit Inhalt Wahr löschen
.Cells.SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
On Error GoTo 0
'Hilfsspalte löschen
.EntireColumn.Delete
End With
End With
.ScreenUpdating = True
.Calculation = iCalc
End With
End Sub