Alarmfunktion

Private Sub Worksheet_Change(ByVal Target As Range) Dim zei If Target.Column > 2 Or Cells(Target.Row, 1) = "" Or Cells(Target.Row, 2) = "" Then Exit Sub For zei = 1 To Range("A65536").End(xlUp).Row If Cells(Target.Row, 1) > Cells(zei, 2) Then MsgBox "FEHLER" Application.EnableEvents = False Target.ClearContents Application.EnableEvents = True Target.Select Exit For End If Next zei End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Klaus,
probiers doch mal damit:

Private Sub Worksheet_Change(ByVal Target As Range)  ' nur Zahlen erlaubt
Dim cc As Range, maxA As Double, minB As Double, istF As Boolean, ccSel As Range
If Intersect(Target, [A:B]) Is Nothing Then Exit Sub
For Each cc In Intersect(Target, [A:B])
If Not IsEmpty(cc) Then
If Not IsNumeric(cc) Then
istF = True
MsgBox cc.Address(0, 0) & " = " & cc & " ist keine Zahl.", vbCritical, "FEHLER"
Else
maxA = WorksheetFunction.Max([A:A])
minB = WorksheetFunction.Min([B:B])
If cc.Column = 1 And cc > minB Then
istF = True
MsgBox cc.Address(0, 0) & " = " & cc _
& " wäre größer als das Minimum von B = " & minB, vbCritical, "FEHLER"
ElseIf cc.Column = 2 And cc < maxA Then
istF = True
MsgBox cc.Address(0, 0) & " = " & cc _
& " wäre kleiner als das Maximum von A = " & maxA, vbCritical, "FEHLER"
End If
End If
If istF Then
Application.EnableEvents = False
cc.ClearContents
Application.EnableEvents = True
If ccSel Is Nothing Then Set ccSel = cc
istF = False
End If
End If
Next cc
If Not ccSel Is Nothing Then ccSel.Select
End Sub

oder damit:

Private Sub Worksheet_Change(ByVal Target As Range)  ' alle Zeichen erlaubt
Dim cc As Range, col As Integer, zei As Long, ccSel As Range
If Intersect(Target, [A:B]) Is Nothing Then Exit Sub
For Each cc In Intersect(Target, [A:B])
If Not IsEmpty(cc) Then
col = 3 - cc.Column
For zei = 1 To Cells(Rows.Count, col).End(xlUp).Row
If Not IsEmpty(Cells(zei, col)) Then
If (col = 1 And cc < Cells(zei, col)) Or (col = 2 And cc > Cells(zei, col)) Then
MsgBox cc.Address(0, 0) & " = " & cc & " wäre " & _
IIf(col = 1, "kleiner", "größer") & " als " & _
Cells(zei, col).Address(0, 0) & " = " & Cells(zei, col), _
vbCritical, "FEHLER"
Application.EnableEvents = False
cc.ClearContents
Application.EnableEvents = True
If ccSel Is Nothing Then Set ccSel = cc
Exit For
End If
End If
Next zei
End If
Next cc
If Not ccSel Is Nothing Then ccSel.Select
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Alarmfunktion

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread