Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range, rngZellen As Range
'Columns(5)= Spalte ; .Offset(1, 0) = wenn Tabelle eine Überschrift hat
Set Bereich = Intersect(Columns(5), ActiveSheet.UsedRange.Offset(1, 0))
If Not Bereich Is Nothing Then
With Application
.ScreenUpdating = False
.EnableEvents = False
Set Bereich = Bereich.Offset(0, 1)
Bereich.FormulaR1C1 = "=If(RC[-1]<>"""",True,"""")"
On Error Resume Next
Set rngZellen = Bereich.SpecialCells(xlCellTypeFormulas, 4)
Bereich.Value = ""
On Error GoTo 0
If Not rngZellen Is Nothing Then
rngZellen.FormulaR1C1 = "=TODAY()"
End If
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub
=WENN(E4"";INDEX(Grunddaten!$B$2:$CI$696;VERGLEICH(D4;Grunddaten!$A$2:$A$696);VERGLEICH(E4; Grunddaten!$B$1:$CI$1;0));"")
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range, rngZellen As Range
'Columns(5)= Spalte ; .Offset(1, 0) = wenn Tabelle eine Überschrift hat
Set Bereich = Intersect(Range(Columns(4), Columns(5)), Target)
If Not Bereich Is Nothing Then
With Application
.ScreenUpdating = False
.EnableEvents = False
If Bereich.Columns(1).Column = 4 Then
Set Bereich = Bereich.Columns(1).Offset(0, 2)
Else
Set Bereich = Bereich.Columns(1).Offset(0, 1)
End If
Bereich.FormulaR1C1 = "=If(AND(RC[-1]<>"""",RC[-2]<>""""),True,"""")"
On Error Resume Next
Set rngZellen = Bereich.SpecialCells(xlCellTypeFormulas, 4)
Bereich.Value = ""
On Error GoTo 0
If Not rngZellen Is Nothing Then
rngZellen.FormulaR1C1 = "=INDEX(Grunddaten!R2C2:R696C87,MATCH(RC[-2],Grunddaten!R2C1:R696C1),MATCH(RC[-1], Grunddaten!R1C2:R1C87,0))"
End If
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub
=WENN(E4"";INDEX(Grunddaten!$B$2:$CI$696;VERGLEICH(D4;Grunddaten!$A$2:$A$696);VERGLEICH(E4; Grunddaten!$B$1:$CI$1;0));"")