Option
Explicit
Private
Sub
Worksheet_Change(
ByVal
Target
As
Range)
Const
C_FORMULA
As
String
=
"=IF(%CELL%=%CELL_VALUE%,%TRUE_PART%,%FALSE_PART%)"
Dim
rngResult
As
Excel.Range
Set
rngResult = Tabelle1.Columns(
"A"
).Find(Target.Cells(1, 1).Value, _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, MatchByte:=
False
)
If
Not
rngResult
Is
Nothing
Then
Set
rngResult = rngResult.Offset(, 3)
Else
Exit
Sub
End
If
Dim
rngCell
As
Excel.Range
Dim
strFormula
As
String
With
Tabelle3
Set
rngCell = .Cells(.Rows.Count,
"A"
).
End
(xlUp)
If
Trim$(rngCell.Value) <>
""
Then
Set
rngCell = rngCell.Offset(1)
End
With
strFormula = Replace$(C_FORMULA,
"%CELL%"
,
"B1"
, Compare:=vbTextCompare)
strFormula = Replace$(strFormula,
"%CELL_VALUE%"
, IIf(IsNumeric(rngResult.Value), rngResult.Value,
""
""
& rngResult.Value &
""
""
), Compare:=vbTextCompare)
strFormula = Replace$(strFormula,
"%TRUE_PART%"
,
""
"nix"
""
, Compare:=vbTextCompare)
strFormula = Replace$(strFormula,
"%FALSE_PART%"
,
""
"sonst nix"
""
, Compare:=vbTextCompare)
rngCell.Formula = strFormula
End
Sub