Messagebox in Excel anzeigen, wenn bestimmter Wert ausgegeben wird?

... komplette Frage anzeigen

2 Antworten

Damit die erste Antwort kein Bandwurm wird, ein neuer Anlauf:

Wenn ich es richtig verstanden habe sind A, B, C Datum, Uhrzeit und Kategorie einer Veranstaltung. Es darf maximal 6 Buchungen der gleichen Art geben, also gleiches Datum, gleiche Uhrzeit und gleiche Kategorie.

Die Abfrage auf Pivot finde ich sehr unglücklich, weil sich die Pivottabelle abhängig von den Einträgen verschiebt. Ich wüsste da nicht, wie man sicher die richtigen Zellen abfragt. Zudem muss bei diesem Verfahren erst der Eintrag kopiert, die Pivot aktualisiert und alles ggf. wieder zurückgedreht werden.

Daher würde ich die Prüfung entweder als Formel in einer Zelle oder halt im Makro selbst machen und zwar bevor der Eintrag geschrieben wird.

Den ersten Block kannst Du ggf. löschen, falls Du schon anderweitig prüfst, ob alle Eingabefelder auch gefüllt sind.

Im zweiten wird dann geprüft, ob schon mehr als 5 angelegt sind. Sind 6 vorhanden, kann keine weitere Buchung erfolgen und es kommt die Abweisung.

War die Prüfung erfolgreich, werden die Einträge A4:D4 ans Ende der Liste kopiert, die Pivot aktualisiert und die Eingaben gelöscht.

Ich bin beim Beispiel davon ausgegangen, dass in Zeile 8 eine Überschrift steht und ab 9 die Einträge kommen.

Sub buchung()
' Prüfung ob alle Eingabfelder gefüllt sind -> löschen wenn es nicht benötigt wird
If Cells(4, 1).Value = "" Or Cells(4, 2).Value = "" Or Cells(4, 3).Value = "" Or Cells(4, 4).Value = "" Then
MsgBox ("Bitte alle Felder ausfüllen")
Exit Sub
End If

' Prüfen ob inkl. der gewünschten Buchung mehr als 6 entstehen würden
Dim anzzeilen
anzzeilen = Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIfs(Range(Cells(9, 1), Cells(anzzeilen, 1)), Cells(4, 1).Value, Range(Cells(9, 2), Cells(anzzeilen, 2)), Cells(4, 2).Value, Range(Cells(9, 3), Cells(anzzeilen, 3)), Cells(4, 3).Value) > 5 Then
MsgBox ("Diese Buchung ist nicht möglich")
Exit Sub
End If

' Buchung eintragen
For i = 1 To 4
Cells(anzzeilen + 1, i).Value = Cells(4, i).Value
Next
ActiveSheet.PivotTables("PivotTable3").PivotCache.Refresh
Range(Cells(4, 1), Cells(4, 4)) = "" 'löschen der Eingaben
MsgBox ("Buchung erfolgreich erfasst")
End Sub


Antwort bewerten Vielen Dank für Deine Bewertung
Kommentar von melsen03
19.01.2016, 13:02

Síeht super aus Danke erstmal!! Leider zeigts mir beim Ausführen den Fehler "Typen sind unverträglich...

Kannst du mir bitte damit eventuell nochmal helfen?

0

Es wäre aus meiner Sicht eleganter die Abfrage an das bestehende Makro anzuhängen als das Tabellenblatt laufend auf Änderungen zu kontrollieren und dann die Messagebox aufzurufen. Außerdem ist es dann ja eigentlich zu spät, dann wurde der Eintrag schon vorgenommen. Das zurückdrehen ist komplizierter, als wenn man den Eintrag gleich verhindert.

Wie ist denn das Makro bisher aufgebaut? Code wäre notwendig, um die konkrete Änderung auch zu beschreiben.

Die Abfrage wäre dann sinngemäß: Wenn Zielfeld + neue Eingabe >6 dann...



Antwort bewerten Vielen Dank für Deine Bewertung
Kommentar von melsen03
18.01.2016, 11:38

Momentan hab ich nur folgendes:

Range ("A4") . Select

Selection.Copy

ActiveWindow.SmallScroll Down:=3

Range ("A8"). Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,SkipBlanks_ := False, Transpose:= False

DAS GLEICHE FÜR B4 BIS D4

Range ("A8:D8"). Select

Selection.Insert Shift:=xlDown, CopyOrigin:= xlFormatFromLeftOrAbove

Sheets ("Übersicht").Select

ActiveSheet.PivotTables("PivotTable3").PivotSelect "Termine[All]", xlLabelOnly_+ xlFirstRow, True

ActiveSheet.PivotTables("PivotTable3").PivotCache.Refresh

End Sub

Ich hab nicht wirklich nen Plan von MAkros, hab das hier mit Makro aufzeichnen gemacht.

Danke schonmal für deine Hilfe

0