AW: Zeile einfügen u.Formel v.Zelle darüber überne
25.03.2008 08:30:24
fcs
Hallo Karsten,
das Problem erfordert nun mal dass verschiedenen Eventualitäten geprüft werden müssen.
Hier die angepasste Version, die auch beim Einfügen von Leerzeilen die Formeln einfügt wenn Werte eingegeben werden - natürtlich wieder ein bischen länger.
Außerdem eine "Sparversion", die nur auf Eingaben in Spalte B reagiert und in der letzten Zeile nicht die nächste Eingabezelle selektiert.
Gruß
Franz
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Listeneingabe bei Eingabe in neuer Zeile werden Formeln kopiert
Dim objZelle As Range, arrFormelSpalten
Dim lngSpalte As Long, intJ As Integer, bolFormel, lngOffset As Long
Const lngSpalte1 As Long = 1 'Erste Spalte der Liste
Const lngSpalteL As Long = 7 'Letzte Spalte der Liste
Const lngZeile1 As Long = 2 '1. Zeile mit Formel
arrFormelSpalten = Array(1, 3) 'Spalten mit Formeln
With Me
For Each objZelle In Target
'Prüfen ob geänderte Zeile(n) Formel enthält
If Not .Cells(objZelle.Row, arrFormelSpalten(0)).HasFormula _
And objZelle.Row >= lngZeile1 _
And objZelle.Column = lngSpalte1 Then
bolFormel = True
Application.EnableEvents = False
'Formel in Spalten kopieren
For lngSpalte = LBound(arrFormelSpalten) To UBound(arrFormelSpalten)
Select Case objZelle.Row
Case lngZeile1
'Zeile direkt unter Spaltentitel eingefügt
.Range(.Cells(objZelle.Row, arrFormelSpalten(lngSpalte)), _
.Cells(objZelle.Row, arrFormelSpalten(lngSpalte)).End(xlDown)).FillUp
Case Is = lngSpalte1 _
And Target.Column lngSpalteL Then
lngSpalte = lngSpalte1 'ab 1. Spalte prüfen
lngOffset = 1 'Nächste Zeile selektieren wenn Eingabe in Letzter Spalte
End If
'Prüfen, ob Spalte Formel enhält
bolFormel = False
For intJ = LBound(arrFormelSpalten) To UBound(arrFormelSpalten)
If lngSpalte = arrFormelSpalten(intJ) Then bolFormel = True: Exit For
Next
If bolFormel = False Then
'Zelle selektieren
.Cells(Target.Row + lngOffset, lngSpalte).Select
Exit Do
End If
lngSpalte = lngSpalte + 1
Loop
End If
End With
End Sub
'#### Sparversion #####
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Sparversion, Formeln werden ggf. bei Werteingabe in Spalte B eingefügt
'Listeneingabe bei Eingabe in neuer Zeile werden Formeln kopiert
Dim objZelle As Range, arrFormelSpalten
Dim lngSpalte As Long
Const lngZeile1 As Long = 2 '1. Zeile mit Formel
Const lngSpalteE As Long = 2 'Spalte bei deren Eingabe ggf. Formel kopiert wird
arrFormelSpalten = Array(1, 3) 'Spalten mit Formeln
With Me
For Each objZelle In Target
'Prüfen ob geänderte Zeile(n) Formel enthält
If Not .Cells(objZelle.Row, arrFormelSpalten(0)).HasFormula _
And objZelle.Row >= lngZeile1 _
And objZelle.Column = lngSpalteE Then
Application.EnableEvents = False
'Formel in Spalten kopieren
For lngSpalte = LBound(arrFormelSpalten) To UBound(arrFormelSpalten)
Select Case objZelle.Row
Case lngZeile1
'Zeile direkt unter Spaltentitel eingefügt
.Range(.Cells(objZelle.Row, arrFormelSpalten(lngSpalte)), _
.Cells(objZelle.Row, arrFormelSpalten(lngSpalte)).End(xlDown)).FillUp
Case Is