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 gefunden Then
gefunden = False
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
End If
Next j
rng2.Value = W2
End Sub
Falls ich deinen bisherigen Code richtig gedeutet habe. Waren außerdem einige Schreibfehler drinnen, da solltest du genauer drauf achten.
|