AW: Messagebox durch Bedingung öffnen
24.08.2016 16:53:51
Phia
Hi,
der ganze Code:
Sub Worksheet_Change (ByVal Target as Range)
Dim Bereich1 As Range
Dim Bereich2 As Range
Dim Bereich3 As Range
Dim Bereich4 As Range
Dim Bereich5 As Range
Dim Bereich6 As Range
Dim Bereich7 As Range
Dim Bereich8 As Range
Dim Bereich9 As Range
Dim Bereich10 As Range
Dim Bereich11 As Range
Set Bereich1 = Range(Cells(8, 4), Cells(47, 90))
If Intersect(Target, Bereich1) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "nicht i.O." Then
MsgBox "Achtung - Wert außerhalb"
End If
Set Bereich2 = Range(Cells(8, 4), Cells(47, 90))
If Intersect(Target, Bereich2) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "nicht erledigt" Then
MsgBox "Achtung - Nachholen"
End If
Set Bereich3 = Range(Cells(22, 4), Cells(22, 90))
If Not Intersect(Target, Bereich3) Is Nothing Then
If IsEmpty(Target.Offset(-1, 0)) Then
Target.Offset(-1, 0).Value = Now
End If
End If
Set Bereich4 = Range(Cells(24, 4), Cells(24, 90))
If Not Intersect(Target, Bereich4) Is Nothing Then
If IsEmpty(Target.Offset(-1, 0)) Then
Target.Offset(-1, 0).Value = Now
End If
End If
Set Bereich5 = Range(Cells(26, 4), Cells(26, 90))
If Not Intersect(Target, Bereich5) Is Nothing Then
If IsEmpty(Target.Offset(-1, 0)) Then
Target.Offset(-1, 0).Value = Now
End If
End If
Set Bereich6 = Range(Cells(28, 4), Cells(28, 90))
If Not Intersect(Target, Bereich6) Is Nothing Then
If IsEmpty(Target.Offset(-1, 0)) Then
Target.Offset(-1, 0).Value = Now
End If
End If
Set Bereich7 = Range(Cells(30, 4), Cells(30, 90))
If Not Intersect(Target, Bereich7) Is Nothing Then
If IsEmpty(Target.Offset(-1, 0)) Then
Target.Offset(-1, 0).Value = Now
End If
End If
Set Bereich8 = Range(Cells(32, 4), Cells(32, 90))
If Not Intersect(Target, Bereich8) Is Nothing Then
If IsEmpty(Target.Offset(-1, 0)) Then
Target.Offset(-1, 0).Value = Now
End If
End If
Set Bereich9 = Range(Cells(45, 4), Cells(45, 90))
If Not Intersect(Target, Bereich9) Is Nothing Then
If IsEmpty(Target.Offset(-1, 0)) Then
Target.Offset(-1, 0).Value = Now
End If
End If
Set Bereich10 = Range(Cells(10, 4), Cells(10, 90))
If Intersect(Target, Bereich10) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target > WorksheetFunction.Sum(Range("G3, Y1") Or Target > WorksheetFunction.Sum(Range(" _
G3, Y1") Then
MsgBox "Achtung - Wert außerhalb"
End If
Set Bereich11 = Range(Cells(16, 4), Cells(16, 90))
If Intersect(Target, Bereich11) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target > WorksheetFunction.Sum(Range("G4, Y1") Or Target > WorksheetFunction.Sum(Range(" _
G4, Y1") Then
MsgBox "Achtung - Wert außerhalb"
End If
End Sub
Bis Bereich10 funktioniert alles einwandfrei. Und ab Bereich 11 geht nichts mehr egal welche Bedingung ich wähle.
Lg
Phia