Anzeige
Archiv - Navigation
1508to1512
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Messagebox durch Bedingung öffnen

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

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

Betreff
Datum
Anwender
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige