Option
Explicit
Sub
BEST()
Dim
lngRow
As
Long
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
Set
RngA = myRange(Sh)
RngA.Columns(3).SpecialCells(4).EntireRow.Delete
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
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