Option
Explicit
Sub
prufen()
Dim
i
As
Integer
Dim
j
As
Integer
Dim
k
As
Integer
Dim
shPrüfen
As
Worksheet
Dim
W1, W2, rng2
As
Range
Dim
gefunden
As
Boolean
With
Worksheets(
"seite1"
)
W1 = .Range(.Cells(Rows.Count, 1).
End
(xlUp), .Cells(3, 5)).Value
End
With
With
Worksheets(
"seite2"
)
Set
rng2 = .Range(.Cells(Rows.Count, 1).
End
(xlUp), .Cells(2, 21))
W2 = rng2.Value
End
With
Set
shPrüfen = Worksheets(
"zuPrüfen"
)
For
j = 1
To
UBound(W2)
For
i = 1
To
UBound(W1)
If
W2(j, 1) = W1(i, 1)
And
_
W2(j, 21) = W1(i, 2)
And
_
W2(j, 9) = W1(i, 3)
And
_
W2(j, 8) = W1(i, 4)
And
_
(W2(j, 6) <= W1(i, 5)
Or
W1(i, 5) =
""
) _
Then
gefunden =
True
Exit
For
End
If
Next
i
If
not gefunden
Then
k = k + 1
With
shPrüfen
.Cells(k, 1).Value = W2(j, 1)
.Cells(k, 2).Value = W2(j, 21)
.Cells(k, 3).Value = W2(j, 9)
.Cells(k, 4).Value = W2(j, 8)
.Cells(k, 5).Value = W2(j, 6)
.Cells(k, 6).Value = W2(j, 12)
End
With
else: gefunden =
False
End
If
Next
j
rng2.Value = W2
End
Sub