Option Explicit
Sub BEST()
Dim lngRow As Long 'jeweils letzte Zeile, wozu mehr
Dim i As Long
Dim Sh As Excel.Worksheet
Set Sh = ActiveSheet
Application.ScreenUpdating = False
With Sh
lngRow = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row
For i = lngRow To 2 Step -1
If .Cells(i, 3) = "" Then
.Rows(i).Delete
End If
Next i
'
lngRow = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row
For i = lngRow To 2 Step -1
If .Cells(i, 11) = "ERLEDIGT" Or Cells(i, 11) = "ABGESCHLOSSEN (MENGENMÄSSIG)" Or Cells(i, 11) = "ABGESCHLOSSEN (WERTMÄSSIG)" Or Cells(i, 11) = "KOMPL.GELIEFERT" Or Cells(i, 11) = "STORNIERT" Or Cells(i, 11) = "" Then
.Rows(i).Delete
End If
Next i
'
lngRow = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row
For i = lngRow To 2 Step -1
If .Cells(i, 1) = "inaktiv" Then
.Rows(i).Delete
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
Sub ULTIMATE()
Dim Sh As Excel.Worksheet
Dim RngA As Range
Dim V As Variant
Dim Arr11() As String
Arr11 = Split("ERLEDIGT,ABGESCHLOSSEN (MENGENMÄSSIG),ABGESCHLOSSEN (WERTMÄSSIG),KOMPL.GELIEFERT,STORNIERT", ",")
Application.ScreenUpdating = False
Set Sh = ActiveSheet
With Sh
On Error Resume Next
'If Cells(i, 3) = "" Then
Set RngA = myRange(Sh)
RngA.Columns(3).SpecialCells(4).EntireRow.Delete
'If Cells(i, 11) = "ERLEDIGT" Or
Set RngA = myRange(Sh)
For Each V In Arr11
RngA.Columns(11).Replace V, "", 1, 1
Next V
RngA.Columns(11).SpecialCells(4).EntireRow.Delete
'If Cells(i, 1) = "inaktiv"
Set RngA = myRange(Sh)
RngA.Columns(1).Replace V, "inaktiv", 1, 1
RngA.Columns(11).SpecialCells(4).EntireRow.Delete
On Error GoTo 0
End With
Application.ScreenUpdating = True
End Sub
Private Function myRange(wsh As Worksheet) As Range
Dim lngRow As Long, lngCol As Long
With wsh
lngRow = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row
lngCol = .Cells.Find("*", .Cells(1), -4123, 2, 2, 2, False).Column
Set myRange = Range(.Cells(1, 1), .Cells(lngRow, lngCol))
End With
End Function
|