Mehrere Aktionen nach Worksheet_Change

Bild

Betrifft: Mehrere Aktionen nach Worksheet_Change von: Harald E
Geschrieben am: 11.03.2005 10:24:14

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.
Bild


Betrifft: AW: Mehrere Aktionen nach Worksheet_Change von: Matthias G
Geschrieben am: 11.03.2005 10:48:43

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


Bild


Betrifft: Strg+C und Strg+V kann eben nicht jeder von: Harald E
Geschrieben am: 11.03.2005 11:08:44

....dabei ist es wohl passiert. Danke Matthias

Und ich schwebe gerade mit einem leidenden Gesichtausdruck zum Fenster raus

Gruß
Harald


Bild


Betrifft: Lösung ?! von: Harald E
Geschrieben am: 11.03.2005 13:31:30

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



Bild


Betrifft: Doch nicht von: Harald E
Geschrieben am: 11.03.2005 14:09:03

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


Bild


Betrifft: AW: Jetzt aber von: Martin Beck
Geschrieben am: 11.03.2005 17:09:26

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


Bild


Betrifft: Klasse von: Harald E
Geschrieben am: 14.03.2005 07:23:33

Hallo Martin,

vielen herzlichen Dank für die Spitzen-Hilfeleistung.

Harald


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Mehrere Aktionen nach Worksheet_Change"