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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen