Hier ist der Code dazu ;)
Option
Explicit
Dim
Einsatzgebiet
As
Variant
Sub
Aufbereiten()
On
Error
GoTo
Err_Handler
Dim
letzteZeile
As
Integer
Dim
i
As
Integer
Dim
n
As
Integer
Dim
EinsatzgebietNr
As
Variant
ActiveWorkbook.RefreshAll
Application.ScreenUpdating =
False
With
Tabelle4
.Range(
"B2"
).Value =
"Einsatzgebiet"
letzteZeile = .Range(
"A"
& .Rows.Count).
End
(xlUp).Row
i = letzteZeile
n = 3
For
i = 1
To
letzteZeile - 2
If
IsNumeric(.Range(
"B"
& n))
Then
EinsatzgebietNr = .Range(
"B"
& n).Value
LoseErmitteln EinsatzgebietNr
.Range(
"B"
& n).Value = Einsatzgebiet
End
If
letzteZeile = letzteZeile - 1
n = n + 1
Next
End
With
Application.ScreenUpdating =
True
Exit
Sub
Err_Handler:
MsgBox
"Fehler in Sub: Aufbereiten"
& vbCrLf & vbCrLf & Err.Number &
" "
& Err.Source & vbCrLf & Err.Description, ,
"Fehlermeldung"
End
Sub
Sub
LoseErmitteln(EinsatzgebietNr
As
Variant
)
Dim
letzteZeileLose
As
Integer
Dim
i
As
Integer
Dim
n
As
Integer
With
Tabelle2
letzteZeileLose = .Range(
"A"
& .Rows.Count).
End
(xlUp).Row
i = letzteZeileLose
n = 2
For
i = 1
To
letzteZeileLose - 1
If
EinsatzgebietNr = .Range(
"A"
& n).Value
Then
Einsatzgebiet = .Range(
"B"
& n).Value
Exit
Sub
End
If
letzteZeileLose = letzteZeileLose - 1
n = n + 1
Next
End
With
End
Sub