HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Mehrere Aktionen nach Worksheet_Change

Mehrere Aktionen nach Worksheet_Change
11.03.2005 10:24:14
Harald
Guten Morgen Forum,
ich tüftle gerade an einer zusätzlichen Aufgabe für ein Ereignis
Mit folgenden Code (ursprünglich von Hajo) wird bei Änderung links neben der betreffenden Zelle das Datum eingetragen

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Row = 1 Or Target.Count > 1 Then Exit Sub
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Range("F16:F350")
Application.EnableEvents = False
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
RaZelle.Offset(0, -1) = Date
RaZelle.Offset(0, -2) = "o"
Next RaZelle
Application.EnableEvents = True
Set RaBereich = Nothing
End If
End Sub

Zusätzlich soll nun auch links neben dem Datum ein "x" eingetragen werden (als Status-Spalte).
Dies hier tuts nicht. Ebenso wenig gehts mit AND, & oder vorstehenden Punkten
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
RaZelle.Offset(0, -1) = Date
RaZelle.Offset(0, -2) = "x"
Wie bekomm ich den zweiten Befehl (RaZelle.Offset(0, -2) = "x") da rein ?
Habe auch schon an Selection_Change gedacht, aber da sollen auch noch einige "Komfort-Funktionen" rein.
Danke schonmal
Harald
P.S.: Wenn-Formel bringt auch nix, da das x in der Status-Spalte nicht dauerhaft stehen bleiben soll.

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Benutzer
AW: Mehrere Aktionen nach Worksheet_Change
11.03.2005 10:48:43
Matthias
Hallo Harald,
du bist mit den If..End If ein wenig durcheinandergeraten.
So sollte es klappe:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Row = 1 Or Target.Count > 1 Then Exit Sub
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Range("F16:F350")
Application.EnableEvents = False
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
RaZelle.Offset(0, -1) = Date
RaZelle.Offset(0, -2) = "o"
End If
Next RaZelle
Application.EnableEvents = True
Set RaBereich = Nothing
End Sub
Gruß Matthias
Strg+C und Strg+V kann eben nicht jeder
11.03.2005 11:08:44
Harald
....dabei ist es wohl passiert. Danke Matthias
Und ich schwebe gerade mit einem leidenden Gesichtausdruck zum Fenster raus
Gruß
Harald
Lösung ?!
11.03.2005 13:31:30
Harald
Falls noch jemand interessiert ist.
Es lag nicht am End if.
Es lag am Zeilenumbruch nach Then. Der Code muss direkt danach in gleicher Zeile weitergehen. WARUM AUCH IMMER !?
Bin zufällig drauf gestossen.
Hier der Code, so wie er funzt.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Row < 16 Or Target.Count > 1 Then Exit Sub
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Range("F:F")
Application.EnableEvents = False
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then RaZelle.Offset(0, -1) = Date
RaZelle.Offset(0, -2) = "X"
Next RaZelle
Application.EnableEvents = True
Set RaBereich = Nothing
End Sub

Doch nicht
11.03.2005 14:09:03
Harald
Hi nochmal und sorry. Der Code funzt doch nicht richtig.
Soll: Bei Eintrag in Spalte F (ab Zeile 16 aufwärts) soll in Spalte E das Datum und in Spalte D ein "x" stehen.
Nach Enter in Spalte F aktive Zelle 1 Feld nach rechts (G)
nach Enter in Spalte G aktive Zelle 3 Felder nach rechts (J)
nach Enter in Spalte J wieder zurück nach F und eine Zeile tiefer

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Row < 16 Or Target.Count > 1 Then Exit Sub
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Range("F:F") 'optional ("F16:F350")
Application.EnableEvents = False
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then RaZelle.Offset(0, -1) = Date
RaZelle.Offset(0, -2) = "x"
Next RaZelle
Application.EnableEvents = True
Set RaBereich = Nothing
'nach weiteren Eingaben, definierte Zelle anspringen
If Target.Column = 6 Then Target.Offset(0, 1).Select
If Target.Column = 7 Then Target.Offset(0, 3).Select
If Target.Column = 9 Then Target.Offset(1, -4).Select
End Sub

Ist-Situation. Wenn ich eine Zeile komplett durchspiele, hab ich 4mal ein x in der Zeile (jeweils offset(0,-2)).
Versuch: For Each RaZelle In Range(Target.Address)
statt In Range In RaBereich brachte nur ne Fehlermeldung.
Hoffe es findet sich noch jemand, der sich der Problematik annimmt....oder mir sagt, dass Excel das nicht schafft. Dann muss ich ne Alternative suchen.
Vielleicht seh ich auch nur vor lauter Bäumen den Wald nicht.
Danke schonmal
Harald
AW: Jetzt aber
11.03.2005 17:09:26
Martin
Hallo Harald,

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim RaBereich As Range
If Target.Row < 16 Or Target.Count > 1 Then Exit Sub
Set RaBereich = Range("F:F") 'optional ("F16:F350")
Application.EnableEvents = False
If Not Intersect(Target, RaBereich) Is Nothing Then
Target.Offset(0, -1) = Date
Target.Offset(0, -2) = "x"
End If
Application.EnableEvents = True
Set RaBereich = Nothing
'nach weiteren Eingaben, definierte Zelle anspringen
If Target.Column = 6 Then Target.Offset(0, 1).Select
If Target.Column = 7 Then Target.Offset(0, 3).Select
If Target.Column = 10 Then Target.Offset(1, -4).Select
End Sub

Kommentar zu Deinem Code:
1)Das "X" wird auch dann gesetzt, wenn es nicht sein soll, weil es nicht in die IF-Bedingung eingebunden ist.
2) Spalte J ist die Spalte 10, nicht 9. Daher funktioniert der Rücksprung zu Spalte F nicht.
3) Die For-Each-Schleife ist überflüssig, da Du schon in der ersten Codezeile absichert, daß Target nur eine Zelle ist.
Gruß
Martin Beck
Klasse
14.03.2005 07:23:33
Harald
Hallo Martin,
vielen herzlichen Dank für die Spitzen-Hilfeleistung.
Harald

Meistgelesene Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Ihre Stimme zählt!