Option
Explicit
Public
Sub
SucheNachInhalten()
Dim
rngTable1
As
Excel.Range
Dim
rngTable2
As
Excel.Range
Set
rngTable1 = Tabelle1.Range(Tabelle1.Range(
"A1"
).
End
(xlToRight), Tabelle1.Range(
"A1"
).
End
(xlDown))
Set
rngTable2 = Tabelle2.Range(Tabelle2.Cells(1, Tabelle2.Columns.Count).
End
(xlToLeft), Tabelle2.Range(
"A1"
).
End
(xlDown))
Dim
rngCell
As
Excel.Range
Dim
strName
As
String
Dim
i
As
Long
Dim
j
As
Long
For
i = 2
To
rngTable1.Rows.Count
For
j = 2
To
rngTable1.Columns.Count
strName = rngTable1.Cells(1, j).Value &
"_"
& rngTable1.Cells(i, 2).Value &
"_"
& rngTable1.Cells(i, 1).Value
Call
rngTable1.Worksheet.Names.Add(Name:=strName, RefersTo:=rngTable1.Cells(i, j))
Next
Next
With
rngTable2.Resize(rngTable2.Rows.Count - 1, rngTable2.Columns.Count - 1).Offset(1, 1)
.FormulaR1C1 =
"=IF("
& _
"OR(ISERROR(INDIRECT(CONCATENATE("
"Tabelle1!"
",R1C,"
"_"
",RC1))),ISBLANK(INDIRECT(CONCATENATE("
"Tabelle1!"
",R1C,"
"_"
",RC1)))),"
& _
""
""
","
& _
"INDIRECT(CONCATENATE("
"Tabelle1!"
",R1C,"
"_"
",RC1))"
& _
")"
.Value = .Value
End
With
Do
While
rngTable1.Worksheet.Names.Count > 0
Call
rngTable1.Worksheet.Names(1).Delete
Loop
End
Sub