Mehrere Aktionen nach Worksheet_Change

Forumthread: 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

Anwender

AW: Mehrere Aktionen nach Worksheet_Change

11.03.2005 10:48:43

Matthias
Strg+C und Strg+V kann eben nicht jeder

11.03.2005 11:08:44

Harald
Lösung ?!

11.03.2005 13:31:30

Harald
Doch nicht

11.03.2005 14:09:03

Harald
AW: Jetzt aber

11.03.2005 17:09:26

Martin
Klasse

14.03.2005 07:23:33

Harald

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

Beliebteste Forumthreads (12 Monate)

Mehrere Aktionen nach Worksheet_Change

Forumthread: Mehrere Aktionen nach Worksheet_Change

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread