title image


Smiley Probleme mit Change-Ereignis - Nr. 1 von 3
Hallo zusammen,



ich habe gerade zum ersten Mal versucht, ein Change-Ereignis einzubauen.

Erstaunlicherweise klappt das auch schon prinzipiell mit dem untenstehenden Code.

Aber ein Fehler steckt da irgendwo drin - und es gibt noch 2 ungelöste Probleme.



Die Tabelle ist 52 Spalten breit und 6.000 Zeilen lang. Relevant für das Change-Ereignis soll nur Spalte 48 sein, in Verbindung mit einer Plausi-Prüfung zum Inhalt von Spalte 46.

(Beide Spalten sind über Auswahl aus einer Gültigkeitsliste mit Text zu füllen, bei Spalte 46: 7 Textvarianten, bei Spalte 48: 29 Auswahlmöglichkeiten.)



Bei jeder Änderung in Spalte 48 soll in Spalte 49 (gesperrt) das aktuelle Tagesdatum eingetragen werden, und die Zellauswahl gleich auf Spalte 50 springen (nächstes Muss-Feld). Nur wenn es einen Widerspruch der Inhalte zwischen den Spalten 46 und 48 gibt, soll dieser Sprung nicht erfolgen, sondern der Benutzer auf den nicht "stimmigen" Eintrag in Spalte 46 verwiesen werden. (Zu 46 gehört auch noch ein Eintrag in 45. Deshalb das komische Extra-Offset, damit auch diese Spalte gleich auf dem Bildschirm sichtbar ist.)



Datums-Eintrag, Sprung auf Folge-Spalte und Sprung auf "unstimmige" Spalte funktionieren und werden auch nur ausgeführt, wenn in Spalte 48 geändert wird. So weit also ok.

Aber wenn in den Spalten 1 oder 2 ein Eintrag mit ENTER bestätigt wird (nicht wenn man mit TAB weitergeht ???), kommt die VBA-Meldung:

"Laufzeitfehler '1004':

Anwendungs- oder objektdefinierter Fehler"

Scheinbar wird bei allen Spalten versucht, die Plausi-Prüfung mit 2 Spalten vorher durchzuführen, was bei Spalten A und B nicht funktionieren kann.



Steckt der Fehler in den If-Konstruktionen, oder muss/kann ich den Anwendungsbereich (Target ?) anders auf die Spalte 48 einschränken?









Private Sub Worksheet_Change(ByVal Target As Range)

'

'setzt bei jeder Änderung in Spalte "Status für Statistik -S-" automatisch

'das aktuelle Datum in die Spalte "Datum S-Stat.";

'außerdem wird geprüft, ob ein entsprechend passender Eintrag unter

'"Abgang - Art" steht:

'  - wenn nicht, kommt eine entsprechende Message-Box und der nicht

'      passende Eintrag unter "Abgang - Art" wird ausgewählt;

'  - sonst wird gleich die Folgespalte "Bemerkungen" ausgewählt.

'

Dim Zelle As Range



For Each Zelle In Target

If Zelle.Column = 48 Then Zelle.Offset(0, 1) = Date

Next

If ActiveCell.Column = 48 And _

   ActiveCell.Value = "Text48-26" And _

   ActiveCell.Offset(0, -2).Value <> "Text46-02" _

   Then

      MsgBox "ACHTUNG !" & vbNewLine & _

         "Fehlender oder falscher Eintrag unter 'Abgang'." & vbNewLine & _

         "In diesem Fall muss dort 'Text46-02' stehen !", vbCritical

   ActiveCell.Offset(0, -3).Select

   Selection.Offset(0, 1).Select

ElseIf ActiveCell.Column = 48 And _

   ActiveCell.Value = "Text48-28" And _

   ActiveCell.Offset(0, -2).Value <> "Text46-03" _

   Then

      MsgBox "ACHTUNG !" & vbNewLine & _

         "Fehlender oder falscher Eintrag unter 'Abgang'." & vbNewLine & _

         "In diesem Fall muss auch dort 'Text46-03' stehen !", vbCritical

   ActiveCell.Offset(0, -3).Select

   Selection.Offset(0, 1).Select

ElseIf ActiveCell.Column = 48 And _

   ActiveCell.Value = "Text48-27" And _

   ActiveCell.Offset(0, -2).Value <> "Text46-04" _

   Then

      MsgBox "ACHTUNG !" & vbNewLine & _

         "Fehlender oder falscher Eintrag unter 'Abgang'." & vbNewLine & _

         "In diesem Fall muss dort 'Text46-04' stehen !", vbCritical

   ActiveCell.Offset(0, -3).Select

   Selection.Offset(0, 1).Select

ElseIf ActiveCell.Column = 48 And _

   ActiveCell.Value = "Text48-29" And _

   ActiveCell.Offset(0, -2).Value <> "Text46-05" And ActiveCell.Offset(0, -2).Value <> "Text46-06" _

   Then

      MsgBox "ACHTUNG !" & vbNewLine & _

         "Fehlender oder falscher Eintrag unter 'Abgang'." & vbNewLine & _

         "In diesem Fall muss dort 'Text46-05' oder 'Text46-06' stehen !", vbCritical

   ActiveCell.Offset(0, -3).Select

   Selection.Offset(0, 1).Select

ElseIf ActiveCell.Column = 48 _

   Then

      ActiveCell.Offset(0, 2).Select

End If



End Sub







Code eingefügt mit Syntaxhighlighter 4.0




Gruß von Frankie



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: