Eintrag erzwingen mit Intersec

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) '"$A$1:$C$14" muss logischerweise vorher mit Dummies gefüllt sein Dim iSect As Range, C As Range Set iSect = Intersect(Target, Range("$A$1:$C$14")) On Error GoTo Errorhandler If Not iSect Is Nothing Then For Each C In Range("$A$1:$C$14") If IsEmpty(C) Then Application.EnableEvents = False Target.Activate MsgBox (Target.Address) Exit For End If Next C End If Errorhandler: Application.EnableEvents = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Daniel!
Würde gerne noch in einer Zeile die Felder "aufsteigend" absichern. Habe "unser" Code etwas geändert wie folgt:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'"A1:E1" muss logisch vorher mit einige Dummies gefüllt sein
Dim iSect As Range, C As Range
Set iSect = Intersect(Target, Range("A1:E1"))
On Error GoTo Errorhandler
If Not iSect Is Nothing Then
For Each C In Range("A1:E1")
Application.EnableEvents = False
If IsEmpty(C) Then
C.Activate
Application.StatusBar = Target.Address & " muss zuerst ergänzt werden!"
'MsgBox (Target.Address & " muss zuerst ergänzt werden!")
End If
Application.EnableEvents = True
Next C
End If
Errorhandler:
Application.EnableEvents = True
End Sub

Anstelle das 1.leere Feld anzuspringen reagiert die SUb "rückwärts"? Ich krieg's nicht hin dass er nacheinander sauber prüft. Kannst du mir (oder wer auch immer) noch helfen?
Franz D.

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Static rng As Range Dim check As Boolean If Not rng Is Nothing Then If rng.Cells.Count = 1 Then If rng.Value = "" Then check = True Application.EnableEvents = False rng.Select Application.EnableEvents = True MsgBox "Bitte Wert eingeben in Zelle " & rng.Address(0, 0) End If End If End If If Not check Then Set rng = Target End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Static rng As Range Dim check As Boolean if target.Cells.count = 1 and Not Intersect(Target, Range("C8:G8")) Is Nothing Then If Not rng Is Nothing Then If rng.Cells.Count = 1 Then If rng.Value = "" Then check = True Application.EnableEvents = False rng.Select Application.EnableEvents = True MsgBox "Bitte Wert eingeben in Zelle " & rng.Address(0, 0) End If End If End If end if If Not check Then Set rng = Target End Sub

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread