Messagebox durch Bedingung öffnen

Forumthread: Messagebox durch Bedingung öffnen

23.08.2016 18:29:21

Phia

Hallo zusammen,
mithilfe von Foreneinträgen konnte ich schon viele VBA Probleme lösen. Doch jetzt kommt ich leider nicht mehr weiter.
Ich habe ein Tabellenblatt erstellt, dass durch Dropdown-Auswahl bzw durch Eingaben in Userformen gefüllt wird. Die Werte/Texte werden durch bedingte Formatierung bewertet - rot/gelb/grün.
Nun wollte ich zusätzlich, dass sich eine Messagebox öffnet, wenn die Zelle rot oder gelb wird. Dafür habe ich in VBA die Bedingung verwendet, die ich auch für die bedingte Formatierung verwendet habe (Farbe selbst auslesen scheint ja nicht so einfach zu sein) Leider stößt mein Aufbau jetzt an seine Grenzen.
Bis jetzt habe ich:

Private Sub Worksheet_Change (ByVal Target as Range)
Dim Bereich1 as Range
Set Bereich1 = Range(Cells(10,6),Cells(10,90))
If Intersect(Target, Bereich1) Is Nothing Then Exit Sub
If Target

Jetzt habe ich das für 10 Bereiche mit entsprechend 10 Bedingungen (Zahlen oder Text) durchgeführt.Funktioniert auch ganz gut. Bei Nummer 11 geht nichts mehr. Bis auf die Range und den Namen "Bereich 11" habe ich nichts zum vorhergehenden verändert. Aber jetzt öffnet sich, egal was ich eingebe, keine Messagebox.
Vielleicht sieht/weiß jemand wo das Problem liegt.
Vielen Dank schon mal im Voraus.
Phia

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Messagebox durch Bedingung öffnen

23.08.2016 18:57:01

ChrisL

Hi Phia
Man müsste wissen, wie du die 10 Bedingungen zusammen geführt hast und was es für Bedingungen sind (Regelmässigkeiten?).

If Intersect(Target, Bereich1) Is Nothing Then Exit Sub

Übersetzung: Wenn Target (die veränderte Zelle) nicht im Bereich liegt, verlasse die Prozedur ganz.
Darum meine Vermutung, die Reihenfolge im Code ist in etwa so:
- Liegt Target-im-Bereich, sonst Exit
- Bedingung
- Liegt Target-im-Bereich, sonst Exit
- Bedingung
- usw.
Wenn die Aktion in der ersten Bereichsprüfung durchfällst, kommt der Code nie in der 10. Bedingung an.
Für eine saubere Lösung müsste man mehr Details kennen (ich vermute man kann die 10 Bedingungen zusammen fassen), aber du könntest auch die Exit-Sub Anweisung raus nehmen.

If Not Intersect(Target, Bereich1) Is Nothing Then
If Target

Doppelte Verneinung: Wenn Target nicht nicht im Bereich liegt, dann Bedingung sonst weiter im Code.
cu
Chris

AW: Messagebox durch Bedingung öffnen

23.08.2016 19:23:11

Phia

Hi
danke für deine schnelle Antwort. Ich glaube ich habe mich ein bisschen unglücklich ausgedrückt.
Als Beispiel (zur Übersicht vereinfacht)
Bereich1 - D4 bis Z4 - If Target = "nicht i.O." dann
Bereich2 - D6 bis Z6 - If Target = "nicht erledigt" dann
Bereich3 - D10 bis Z10 - If Target = Summe(...) dann
und das für 10 Bereiche (funktioniert sehr gut) und ab dem 11. passiert nichts mehr. Habe ich zu viele Bereiche ausgewählt? Gibt es da vielleicht eine Grenze?
Du hattest die Idee mit Zusammenfassen:
Könnte ich dann einfach schreiben
D4 bis Z6 - If Target = "nicht i.O." or Target = "nicht erledigt"
Ich habe da auch einen Summenberechnung dabei:
WorksheetFunction.Sum
Ich würde auch gerne eine Multiplikation machen z.B G5*0,25
Habe leider noch nicht den richtigen Befehl gefunden. (VBA learning by doing :-) )
Hättest du eine Idee?
Phia

AW: Messagebox durch Bedingung öffnen

23.08.2016 20:03:13

ChrisL

Hi Phia
Ich denke nicht, dass es eine Grenze gibt. An Regelmässigkeiten kann ich einzig Spalte D:Z erkennen, dann musst du die Bedingungen vermutlich doch einzeln abfragen. Zeig mal den ganzen Code, vielleicht lässt sich etwas erkennen.
cu
Chris

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

AW: Messagebox durch Bedingung öffnen

24.08.2016 17:24:55

ChrisL

Hi Phia
In Bedingung 10 hast du eine Exit Sub drin, darum kommt der Code nicht bei Bedingung 11 an.
cu
Chri

AW: Messagebox durch Bedingung öffnen

24.08.2016 17:52:19

Phia

Hi,
die Idee hatte ich auch schon, aber das hab ich bei Bereich 1 und 2 auch und trotzdem wird der Code bis Bereich 10 durchgeführt.
Aber Danke für deine Idee
Lg
Phia

Optimierung

24.08.2016 18:56:57

Michael

Hi Phia,
anbei eine optimierte Variante:

Sub Worksheet_Change(ByVal Target As Range)
Const Z1 = "!22!24!26!28!30!32!45!" ' mit ! am Ende geht das mit ALLEN
' Spaltennummern, unabhängig davon, wieviele Stellen die haben
Dim G4 As Long
If Target.Count > 1 Then Exit Sub
If Target.Column  90 Then Exit Sub
' 1. und 2. Bereich
If Target.Row >= 8 And Target.Row  0 Then  ' Bereiche 3 - 9 wie Const Z1
If IsEmpty(Target.Offset(-1, 0)) Then
Target.Offset(-1, 0).Value = Now
End If
End If
' ab hier für Bereiche 10 + 11
' an G4 wird die Zeilennummer für die Summe in Range("G[Zeile]"...
' zugewiesen ...
If Target.Row = 10 Then G4 = 3 Else If Target.Row = 16 Then G4 = 4
' falls Target.Row weder 10 noch 16 ist, bleibt sie 0 (wie Dim)
If G4 > 0 Then
' in Deinem Post fehlt die schließenden Klammern von Sum(Range())
' also geht es so wie gepostet eh nicht
' Außerdem sind beide Vergleiche IDENTISCH, wozu dann "Or"?!
If Target > WorksheetFunction.Sum(Range("G" & G4 & ", Y1")) Or _
Target > WorksheetFunction.Sum(Range("G" & G4 & ", Y1")) Then
MsgBox "Achtung - Wert außerhalb"
End If
End If
End If
End Sub

Ich habe sie mangels "vernünftiger" Daten nicht getestet.
Wie ich darauf komme, kannst Du anhand der Datei nachvollziehen, in der ich Deinen Code analysiert habe: https://www.herber.de/bbs/user/107821.xlsm
Schöne Grüße,
Michael

AW: Optimierung-Nachtrag

24.08.2016 19:02:09

Michael

Hi,
vertippt! Die Zeile

If Target.Row >= 8 And Target.Row

muß auf

If Target.Row >= 8 And Target.Row 47 Then

geändert werden.
M.

AW: Optimierung-Nachtrag

24.08.2016 19:42:18

Phia

Hallo Michael,
vielen Dank für Deine Idee. Ich werde den Code ausprobieren. Und Danke für die Kommentare im Code, die machen das nachvollziehen für mich einfacher.
Lg
Phia

AW: Messagebox durch Bedingung öffnen

24.08.2016 21:53:21

ChrisL

Hi Phia
Bereich 1 + 2 beziehen sich auf alle Zeilen (8-47), aber Bereich 10 nur auf Zeile 10. Kleiner aber entscheidender Unterschied.
Die Optimierung von Michael ist aber sicherlich besser.
cu
Chris

Beliebteste Forumthreads (12 Monate)

Messagebox durch Bedingung öffnen

Forumthread: Messagebox durch Bedingung öffnen

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Messagebox durch Bedingung öffnen

Forumthread: Messagebox durch Bedingung öffnen

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread