Sub
Auswertung
Dim
arr
As
Variant
Dim
Objekt_Nr
As
Variant
Dim
Ergebniss(5000)
As
Variant
Application.ScreenUpdating =
False
Worksheets(
"Tabelle2"
).
Select
LetzteZeile = ActiveSheet.Cells(Rows.Count, 2).
End
(xlUp).Row
For
FortlaufendeNummer = 2
To
LetzteZeile
Nr = ActiveSheet.Cells(FortlaufendeNummer, 5).Value
With
Worksheets(
"Tabelle1"
)
arr = .Range(
"P2:P"
& .Cells(.Rows.Count, 1).
End
(xlUp).Row)
End
With
k = 0
For
i = 2
To
UBound(arr)
If
CStr
(arr(i, 1)) = Nr
Then
ZeileNr = i
Ergebniss(k) = Worksheets(
"Tabelle1"
).Cells(i, 1)
k = k + 1
End
If
Next
If
Ergebniss(0) =
""
Then
Sheets(
"Tabelle2"
).Cells(FortlaufendeNummer, 17) =
"Error"
Erase
Ergebniss
End
If
Erase
Ergebniss
Next
Application.ScreenUpdating =
True
End
Sub