Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 14:05:48
Makro in aktueller Zelle ausführen mit Doppelklick
25.04.2024 12:56:25
Werte von Kunden und Artikel stehen untereinander
25.04.2024 12:55:42
Funktionsparameter auslesen
25.04.2024 11:49:37
Array verwenden
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1556to1560
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1556to1560
1556to1560
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Worksheet_Change

Worksheet_Change
09.05.2017 15:06:05
Ole_Einar
Liebe Community,
eine kurze Anfrage, auf welche Ihr vermutlich mit einem Lachen die Lösung kennt.
Ich habe in meinem Excel-Arbeitsblatt zwei Bereiche, welche bei Befüllung ein Pop-Up Fenster erscheinen lassen sollen.
1. Bereich: Pop-Up Message sobald der Wert größer 10.000 ist.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D14:D21")) Is Nothing Then
If Target.Count = 1 Then
If Target > 10000 Then MsgBox "Maximalwert überschritten"
End If
End If
End Sub
2. Bereich: Pop-Up Message sobald der Wert größer 1 ist.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("L14:L21")) Is Nothing Then
If Target.Count = 1 Then
If Target > 1 Then MsgBox "Rechnung verlinken"
End If
End If
End Sub

Problemstellung:
Einzeln funktionieren diese beiden Befehle einwandfrei, allerdings kann ich nicht beide getrennt voneinander im VBA-Editor einfügen.
Kann mir jemand den Code bereitstellen, damit beide miteinander verbunden warden?
Über eine Erläuterung wie ich weitere Prüfbereiche hinzufügen kann ware ich darüber hinaus äußerst dankbar.
Vielen Dank und Gruß
Ole

19
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Worksheet_Change
09.05.2017 15:12:02
dirk
Hallo!
Du kannst doch Beides in einem Makro kombinieren, etwa so:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D14:D21")) Is Nothing Then
If Target.Count = 1 Then
If Target > 10000 Then MsgBox "Maximalwert überschritten"
End If
ElseIf Not Intersect(Target, Range("L14:L21")) Is Nothing Then
If Target.Count = 1 Then
If Target > 1 Then MsgBox "Rechnung verlinken"
End If
End If
End Sub
Gruss
Dirk aus Dubai
AW: Worksheet_Change
09.05.2017 15:20:18
Ole_Einar
Hallo Dirk,
besten Dank, genau danach habe ich gesucht.
Gibt es auch noch die Möglichkeit vorzugeben, dass ein Pop-Up erscheinen soll, sobald die folgenden beiden Kriterien erfüllt sind:
Zelle: $N$8 = Beteiligung
Zellenbereich: D14 - D21 = Zelle in die zuletzt eingetragen wurde übersteigt 150.000?
D.h. Zelle N8 ist mit Beteiligung gefüllt und im Zellenbereich D14 - D21 ist gerade eine Zelle befüllt worden, deren Betrag 150.000 EUR übersteigt.
Dies ware die dritte Situation im Makro.
Gruß
Ole
Anzeige
AW: Worksheet_Change
09.05.2017 15:29:54
Werner
Hallo,
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D14:D21")) Is Nothing Then
If Target.Count = 1 Then
If Target > 150000 And Range("N8") = "Beteiligung" Then
MsgBox "Maximalwert überschritten"
Application.Undo 'eingegebenen Wert wieder entfernen
End If
End If
End If
End Sub
Gruß Werner
AW: Worksheet_Change
09.05.2017 15:29:58
Ole_Einar
Schonmal Danke im Voraus!
AW: Worksheet_Change
09.05.2017 15:31:35
dirk
Hallo!
Ich hoffe, ich habe Das richtig verstanden, dass in N8 der String "Beteiligung" steht.
So vieleicht (musst den text der MsgBox anpassen):
da erweiterst Du einfach deine If Bedingung: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D14:D21")) Is Nothing Then
If Target.Count = 1 Then
If Target > 150000 and Range("$N$8").value = "Beteiligung" then
MsgBox "Hier sollte jetzt ein aussagekfäftiger Text wegen der 150000Euro stehen"
elseif Target > 10000 Then
MsgBox "Maximalwert überschritten"
end if
End If
ElseIf Not Intersect(Target, Range("L14:L21")) Is Nothing Then
If Target.Count = 1 Then
If Target > 1 Then MsgBox "Rechnung verlinken"
End If
End If
End Sub
Gruss
Dirk aus Dubai
Anzeige
AW: Worksheet_Change
09.05.2017 15:45:05
Ole_Einar
Traumhaft!! Vielen Dank und Gruß
Ole
AW: Worksheet_Change
09.05.2017 17:04:40
Ole_Einar
Ich würde nun noch gerne zwei Punkte zum Makro hinzufügen:
Sofern eine Zelle im Bereich E14:E33 den Betrag 500.000 übersteigt, soll ebenfalls ein Hinweisfeld aufploppen mit dem Hinweis "Prozess einleiten". Sofern dies in Verbindung mit der Kennung "Beteiligung" in Feld N8 vorkommt, soll der Hinweis "Prozess Einleiten - Maximalwert überschritten".
Ich hatte mich am ersten Teil versucht allerdings erhielt ich eine Fehlermeldung. Was ist an diesem Code falsch?:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D14:D21")) Is Nothing Then
If Target.Count = 1 Then
If Target > 150000 and Range("$N$8").value = "Beteiligung" then
MsgBox "Hier sollte jetzt ein aussagekfäftiger Text wegen der 150000Euro stehen"
elseif Target > 10000 Then
MsgBox "Maximalwert überschritten"
end if
End If
ElseIf Not Intersect(Target, Range("L14:L21")) Is Nothing Then
If Target.Count = 1 Then
If Target > 1 Then MsgBox "Rechnung verlinken"
End If
End If
ElseIf Not Intersect(Target, Range("E14:E33")) Is Nothing Then
If Target.Count = 1 Then
If Target > 1000000 Then MsgBox "Prozess einleiten."
End If
End If
End Sub

Vielen Dank im Voraus und beste Grüße.
Anzeige
AW: Worksheet_Change
09.05.2017 18:09:49
Dirk
Hallo!
Du musst auch den "end if" 'rausnehmen, wenn Du die Schleife erweiterst:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D14:D21")) Is Nothing Then
If Target.Count = 1 Then
If Target > 150000 and Range("$N$8").value = "Beteiligung" then
MsgBox "Hier sollte jetzt ein aussagekfäftiger Text wegen der 150000Euro stehen"
elseif Target > 10000 Then
MsgBox "Maximalwert überschritten"
end if
End If
ElseIf Not Intersect(Target, Range("L14:L21")) Is Nothing Then
If Target.Count = 1 Then
If Target > 1 Then MsgBox "Rechnung verlinken"
End If
ElseIf Not Intersect(Target, Range("E14:E33")) Is Nothing Then
If Target.Count = 1 Then
If Target > 500000 and Range("$N$8) = "Beteiligung" Then
MsgBox "Prozess einleiten - Maximalwert überschritten"
elseif Target > 500000 then
MsgBox "Prozess einleiten"
end if
End If
End If
End Sub
Lass' hören, ob ok.
Gruss
Dirk aus Dubai
Anzeige
AW: Worksheet_Change
10.05.2017 08:47:41
Ole_Einar
Hallo Dirk,
ich habe deine Schleife insoweit übernommen, allerdings habe ich noch ein Problem.
Die Zellen É14:E33 sind Ergebisse aus der Multiplikation der Zellen $N$9 (Prozentzahl) und der jeweiligen Nachbarzelle im Bereich D14:D33.
Sofern ich nur einen Wert eingebe funktioniert alles einwandfrei, durch die Formel leider der letzte Teil des Makros nicht.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D14:D21")) Is Nothing Then
If Target.Count = 1 Then
If Target > 150000 and Range("$N$8").value = "Beteiligung" then
MsgBox "Hier sollte jetzt ein aussagekfäftiger Text wegen der 150000Euro stehen"
elseif Target > 10000 Then
MsgBox "Maximalwert überschritten"
end if
End If
ElseIf Not Intersect(Target, Range("L14:L21")) Is Nothing Then
If Target.Count = 1 Then
If Target > 1 Then MsgBox "Rechnung verlinken"
End If
ElseIf Not Intersect(Target, Range("E14:E33")) Is Nothing Then
If Target.Count = 1 Then
If Target > 500000 and Range("$N$8) = "Beteiligung" Then
MsgBox "Prozess einleiten - Maximalwert überschritten"
elseif Target > 500000 then
MsgBox "Prozess einleiten"
end if
End If
End If
End Sub
Muss hierzu eine andere Funktion genutzt warden?
Gruß
Ole
Anzeige
AW: Worksheet_Change
10.05.2017 09:42:13
dirk
Hallo!
In der If Anweisung für die Range "L14:L21" fehlt ein " nach der Range "$N$8.
Ändere die Zeile wie folgt:
If Target > 500000 and Range("$N$8") = "Beteiligung" Then
Dann sollte es gehen.
Gruss
Dirk aus Dubai
AW: Worksheet_Change
10.05.2017 10:30:11
Ole_Einar
Hi Dirk,
Das hatte ich bereits angepasst.
Mein Problem ist allerdings die Formel zur Berechnung der Zellen E14:E33.
Sofern ich einen Wert der den Betrag 500.000 übersteigt manuell eingebe funktioniert das Makro einwandfrei. Sofern ich allerdings den Wert über die Formel D14*$N$9 errechnen lasse funktioniert es nicht richtig.
Beispiel:
N8 ist mit "Beteiligung" befüllt
N9 ist mit 80% Prozent gefüllt
in die Zelle D14 trage ich den Wert 1.000.000 ein.
Die Zelle E14 gibt den Wert 800.000 aus. Nun sollte die Meldung "Prozess einleiten - Maximalwert überschritten" erscheinen.
Allerdings kommt nur die Mitteilung aus folgender Zeile:

If Not Intersect(Target, Range("D14:D21")) Is Nothing Then
If Target.Count = 1 Then
If Target > 150000 and Range("$N$8").value = "Beteiligung" then
MsgBox "Hier sollte jetzt ein aussagekfäftiger Text wegen der 150000Euro stehen"

Dies ist an sich richtig, allerdings gilt diese Mitteilung nur bis zum Wert 500.000. Darüber hinaus sollte die andere Mitteilung erscheinen.
Gruß
Adrian
Anzeige
AW: Worksheet_Change
10.05.2017 11:05:41
Werner
Hallo,
du überwachst mit dem Code den Bereich E14 bis E33. Die Werte in diesem Bereich sind aber das Ergebnis einer Formelberechnung. Eine Formelberechnung in einem Bereich löst aber kein Worksheet_Change Event aus, so dass der Code so nicht funktionieren kann.
In diesem Fall musst du den Zellbereich überwachen, in dem Werte händisch eingegeben werden und deren Eingabe dann die Formelberechnung auslösen.
Aufgrund deiner Beschreibung gehe ich mal davon aus, dass die Eingaben im Bereich D14 bis D33 erfolgen und die Berechnungen dann im Bereich E14 bis E33 ausgelöst werden.
Die Target Zelle wäre dann die Zelle im Bereich D14 bis D33, in der eine Eingabe gemacht wurde. Dann prüfst du die Zelle rechts daneben (mit Offset) auf ihren Wert. Bei Eingabe in D15 wäre das dann E15. Wenn dort der errechnete Wert deine Vorgabe überschreitet und in Zelle N8 das Wort "Beteiligung" steht, dann wird die MsgBox geöffnet.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D14:D33")) Is Nothing Then
If Target.Count = 1 Then
If Target.Offset(0, 1) > 500000 And Range("N8") = "Beteiligung" Then
MsgBox "Wert übersteigt das Maximum."
Application.Undo
End If
End If
End If
End Sub
Gruß Werner
Anzeige
AW: Worksheet_Change
10.05.2017 13:41:04
Ole_Einar
Hallo Werner,
vielen Dank für die Hilfe.
Ich erhalte nun immer die Fehlermeldung "End If ohne If Block" und "Else ohne If"
Ich habe den Code nun folgendermaßen erfasst:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D14:D33")) Is Nothing Then
If Target.Count = 1 Then
If Target.Offset(0, 1) > 1000000 And Range("$N$8").Value = "1 - Führender VR" Then
MsgBox "Large Loss Notification erstellen, Reservevorblatt erstellen und  _
Beteiligte VR informieren, da Reserve größer 150.000."
ElseIf Target > 1000000 Then
MsgBox "Large Loss Notification erstellen und Reservevorblatt befüllen."
ElseIf Target > 150000 And Range("$N$8").Value = "1 - Führender VR" Then
MsgBox "Mitteilung an beteiligte VR senden und Reservevorblatt befüllen"
ElseIf Target > 9999 Then
MsgBox "Reservevorblatt befüllen"
End If
End If
End If
ElseIf Not Intersect(Target, Range("L14:L33")) Is Nothing Then
If Target.Count = 1 Then
If Target > 1 Then MsgBox "Rechnung verlinken"
End If
End If
End Sub
Gruß
Ole
Anzeige
AW: Worksheet_Change
10.05.2017 13:46:40
dirk
Hallo!
So: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D14:D33")) Is Nothing Then
If Target.Count = 1 Then
If Target.Offset(0, 1) > 1000000 And Range("$N$8").Value = "1 - Führender VR" Then
MsgBox "Large Loss Notification erstellen, Reservevorblatt erstellen und " & _
"Beteiligte VR informieren, da Reserve größer 150.000."
ElseIf Target > 1000000 Then
MsgBox "Large Loss Notification erstellen und Reservevorblatt befüllen."
ElseIf Target > 150000 And Range("$N$8").Value = "1 - Führender VR" Then
MsgBox "Mitteilung an beteiligte VR senden und Reservevorblatt befüllen"
ElseIf Target > 9999 Then
MsgBox "Reservevorblatt befüllen"
End If
End If
ElseIf Not Intersect(Target, Range("L14:L33")) Is Nothing Then
If Target.Count = 1 Then
If Target > 1 Then
MsgBox "Rechnung verlinken"
End If
End If
End If
End Sub
Gruss
Dirk aus Dubai
Anzeige
AW: Worksheet_Change
10.05.2017 14:20:59
Ole_Einar
Weltklasse!! Vielen lieben Dank für die Hilfe!
AW: Worksheet_Change
11.05.2017 09:08:45
Ole_Einar
Guten Morgen zusammen,
mir wurde soeben noch eine Ergänzung aufgegeben.
Sobald im Bereich D14:D33 eine Zahl eingegeben wir, soll in der selben Zeile in Spalte F das aktuelle Datum ergänzt werden. Über die Funktion Heute() würde sich das Datum allerdings immer aktualisieren, was ich verhindern möchte.
Dazu habe ich Code 2 gefunden, welche aber immer manuell angesteuert werden muss.
Besteht die Möglichkeit Code 2 in Code 1 zu integrieren?
Code 1:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D14:D33")) Is Nothing Then
If Target.Count = 1 Then
If Target.Offset(0, 1) > 1000000 And Range("$N$8").Value = "1 - Führender VR" Then
MsgBox "Large Loss Notification erstellen, Reservevorblatt erstellen und " & _
"Beteiligte VR informieren, da Reserve größer 150.000."
ElseIf Target > 1000000 Then
MsgBox "Large Loss Notification erstellen und Reservevorblatt befüllen."
ElseIf Target > 150000 And Range("$N$8").Value = "1 - Führender VR" Then
MsgBox "Mitteilung an beteiligte VR senden und Reservevorblatt befüllen"
ElseIf Target > 9999 Then
MsgBox "Reservevorblatt befüllen"
End If
End If
ElseIf Not Intersect(Target, Range("L14:L33")) Is Nothing Then
If Target.Count = 1 Then
If Target > 1 Then
MsgBox "Zahlungsdokument verlinken. Reserve prüfen und ggf. anpassen"
End If
End If
End If
End Sub

Code 2:
Sub Eintragen()
Dim intRow As Integer
For intRow = 14 To 33
If Cells(intRow, 4).Value "" And Cells(intRow, 6).Value = "" Then
Cells(intRow, 6).Value = Date$
End If
Next intRow
End Sub
Vielen Dank im Voraus.
Gruß
Ole
AW: Worksheet_Change
11.05.2017 10:19:03
Werner
Hallo,
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D14:D33")) Is Nothing Then
If Target.Count = 1 Then
If IsNumeric(Target) Then Target.Offset(0, 2) = Date
If Target.Value = 0 Then Target.Offset(0, 2) = "" 'Code Zeile ggf. löschen
If Target.Offset(0, 1) > 1000000 And Range("$N$8").Value = "1 - Führender VR" Then
MsgBox "Large Loss Notification erstellen, Reservevorblatt erstellen und " & _
"Beteiligte VR informieren, da Reserve größer 150.000."
ElseIf Target > 1000000 Then
MsgBox "Large Loss Notification erstellen und Reservevorblatt befüllen."
ElseIf Target > 150000 And Range("$N$8").Value = "1 - Führender VR" Then
MsgBox "Mitteilung an beteiligte VR senden und Reservevorblatt befüllen"
ElseIf Target > 9999 Then
MsgBox "Reservevorblatt befüllen"
End If
End If
ElseIf Not Intersect(Target, Range("L14:L33")) Is Nothing Then
If Target.Count = 1 Then
If Target > 1 Then
MsgBox "Zahlungsdokument verlinken. Reserve prüfen und ggf. anpassen"
End If
End If
End If
End Sub
Ich hab jetzt noch mit drin, dass das Datum in Spalte F wieder entfernt wird, wenn der Eintrag der gleichen Zeile in Spalte D wieder gelöscht wird. Sollte das nicht gewünscht sein, dann die entsprechende Codezeile einfach löschen. Ich hab sie im Code markiert.
Gruß Werner
AW: Worksheet_Change
11.05.2017 12:24:54
Ole_Einar
Traumhaft! Vielen vielen Dank!
Gerne u. Danke für die Rückmeldung. o.w.T.
11.05.2017 12:43:15
Werner

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige