Sub WertInSpalteBGLQUnter16ZeileLoeschen()
->ggf. Anpassen
Const c_Z_ErsteWerteZeile = 2-> erste Zeile mit Statuseintrag
Const c_SP_B = 2
Const c_SP_G = 7
Const c_SP_L = 12
Const c_SP_Q = 17
Const c_GrenzWert = 16
Dim ws As Worksheet, l_ZeileMax As Long, l_tmp As Long, z As Long
Dim l_1 As Double, l_2 As Double, l_3 As Double, l_4 As Double
Dim s_Adresse As String
Set ws = ActiveSheet
l_ZeileMax = 0
l_tmp = ws.Cells(ws.Rows.Count, c_SP_B).End(xlUp).Row
If l_ZeileMax < l_tmp Then l_ZeileMax = l_tmp
l_tmp = ws.Cells(ws.Rows.Count, c_SP_G).End(xlUp).Row
If l_ZeileMax < l_tmp Then l_ZeileMax = l_tmp
l_tmp = ws.Cells(ws.Rows.Count, c_SP_L).End(xlUp).Row
If l_ZeileMax < l_tmp Then l_ZeileMax = l_tmp
l_tmp = ws.Cells(ws.Rows.Count, c_SP_Q).End(xlUp).Row
If l_ZeileMax < l_tmp Then l_ZeileMax = l_tmp
Application.ScreenUpdating = False
For z = l_ZeileMax To c_Z_ErsteWerteZeile Step -1
If IsEmpty(ws.Cells(z, c_SP_B)) Then
l_1 = 0
ElseIf IsNumeric(ws.Cells(z, c_SP_B).Value) Then
l_1 = ws.Cells(z, c_SP_B).Value
Else
s_Adresse = ws.Cells(z, c_SP_B).Address(RowAbsolute:=False, ColumnAbsolute:=False)
MsgBox (in & s_Adresse & ist kein numerischer Wert. ->Abbruch)
GoTo Aufraeumen
End If
If IsEmpty(ws.Cells(z, c_SP_G)) Then
l_2 = 0
ElseIf IsNumeric(ws.Cells(z, c_SP_G).Value) Then
l_2 = ws.Cells(z, c_SP_G).Value
Else
s_Adresse = ws.Cells(z, c_SP_G).Address(RowAbsolute:=False, ColumnAbsolute:=False)
MsgBox (in & s_Adresse & ist kein numerischer Wert. ->Abbruch)
GoTo Aufraeumen
End If
If IsEmpty(ws.Cells(z, c_SP_L)) Then
l_3 = 0
ElseIf IsNumeric(ws.Cells(z, c_SP_L).Value) Then
l_3 = ws.Cells(z, c_SP_L).Value
Else
s_Adresse = ws.Cells(z, c_SP_L).Address(RowAbsolute:=False, ColumnAbsolute:=False)
MsgBox (in & s_Adresse & ist kein numerischer Wert. ->Abbruch)
GoTo Aufraeumen
End If
If IsEmpty(ws.Cells(z, c_SP_Q)) Then
l_4 = 0
ElseIf IsNumeric(ws.Cells(z, c_SP_Q).Value) Then
l_4 = ws.Cells(z, c_SP_Q).Value
Else
s_Adresse = ws.Cells(z, c_SP_Q).Address(RowAbsolute:=False, ColumnAbsolute:=False)
MsgBox (in & s_Adresse & ist kein numerischer Wert. ->Abbruch)
GoTo Aufraeumen
End If
If (l_1 < c_GrenzWert) Or (l_2 < c_GrenzWert) Or _
(l_3 < c_GrenzWert) Or (l_4 < c_GrenzWert) Then
ws.Rows(z).Delete
End If
Next
Application.ScreenUpdating = True
Aufraeumen:
Set ws = Nothing
End Sub
