Personenbezogene Begrenzung Eingabe der Anzahl der Prioritäten

[Elex]

Dann sind wir nur noch bei VBA.

[Tommiks]

Nehme gerne an,denn aus der Datei musste ich eine Maktro-Datei machen.

[Elex]

Um hier eine Code zu schreiben sind mir aber die Vorgaben zu unpräzise und wechselhaft.

Mach es einfach so. Blende das Hilfsblatt meinetwegen aus.
  Mappe1.xlsx (Größe: 13,44 KB / Downloads: 2)

[Tommiks]

Anbei die Original Datei mit geänderten Namen, entfernten Textinhalte.
Ansonsten ist die Datei Original , nur dass der Inhalt fehlt.

Vielen Dank für Deine Unterstützung.

[Elex]

Hallo

Der Code kommt in das Modul DieseArbeitsmappe.

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Blätter, k As Long, PrioAnz(1 To 3) As Long, Summe As Long

' ier alle relevanten Blattnamen
Blätter = Array("DC1", "CD1", "CD2", "DC2", "DC12", "MD11", "MC13", "Linie 1", "L 3", "L 4", "Halle", "Kardex", "Allgemein")

'Check ob die Änderung auf einem relavanten Blatt war
For k = 0 To UBound(Blätter)
  If Blätter(k) = Sh.Name Then Exit For
Next k
If k > UBound(Blätter) Then Exit Sub  'Änderung war auf anderem Blatt

'Check ob die Änderung in Spalte F war
If Not Application.Intersect(Target.Cells(1), Sh.Range("F:F")) Is Nothing Then
  If Target.Cells.Count > 1 And Target.Cells(1) <> "" Then
    MsgBox "In Spalte F darf jeweils nur eine Zelle geändert werden. Die Aktion wird Rückgängig gemacht."
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
  End If
Else
  Exit Sub   'Änderung war nicht in Spalte F
End If

'Wenn Änderung im relevaten Bereich war dann Hier weiter
PrioAnz(1) = 1
PrioAnz(2) = 3
PrioAnz(3) = 5

If Target.Value > 0 And Target.Value < 4 Then
For k = 0 To UBound(Blätter)
  Summe = Summe + WorksheetFunction.CountIfs(Sheets(Blätter(k)).Range("F3:F1000"), Target.Value, Sheets(Blätter(k)).Range("G3:G1000"), Target.Offset(, 1).Value)
  If Summe > PrioAnz(Target.Value) Then
    MsgBox "Max Anzahl an Prio bereits vergeben. Die Aktion wird Rückgängig gemacht."
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
    Exit Sub
  End If
Next k
End If
End Sub

Gruß Elex

[Tommiks]

Eine Korrektur ist erforderlich  

Ich füge die Datei ein.Denn in der Datei habe ich an dem Namen "Vettel" probiert.

Die Datei hat zurzeit 13 Arbeitsblätter, Vettel kann sich in jedem Arbeitsblatt die Priorität 1 vergeben. Aber das soll er nicht dürfen. Vettel darf sich in der ganzen Datei nur einmal Priorität 1 vergeben. Das gilt für die Priorität 2, Vettel kann in jedem Arbeitsblatt sich 3-Mal die Priorität 2 vergeben. Dann würde sich Vettel übernehmen. Denn dann hätte er (13-Prio 1+ 39-Prio 2+65-Prio 3) 117 Aufgaben. Das ist viel zu viel für ihn und für alle Kollegen.

Vettel (das gilt für jeden Kollegen) darf in der ganzen Datei am Ende nur 9 Aufgaben (1-Prio 1; 3-Prio 2, 5-Prio 3) erhalten.

[Elex]

Moin

In der Datei steht mein Code in einem allgemeinem Modul. Ich hatte geschrieben das er in das Modul "Diese Arbeitsmappe" muss. Das Modul steht ganz oben über den Modulen der Arbeitsblätter. Versuch es so und teste.

Gruß Elex

[Tommiks]

Danke für die Hilfe....

Nach weiteren zwei Anläufen habe ich den Code richtig platziert.


Als ich die Prioritäten gelöscht hatte , wurde "Laufzeitfehler 13" angezeigt.
Anschließend wurde der folgende Code " If Target.Value > 0 And Target.Value < 4 Then" gelb angezeigt. Danke...

[Elex]

Hi

Übernimm den neuen Code Komplet. Habe ihn an zwei Zeilen geändert. Die Texte in den MSGBOXen kannst du ja noch anpassen.
Du solltest den Code auch mal durchgehen. Ob Dir die Range's reichen. Habe jetzt bis Zeile 1000 angegeben.

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Blätter, k As Long, PrioAnz(1 To 3) As Long, Summe As Long

' ier alle relevanten Blattnamen
Blätter = Array("DC1", "CD1", "CD2", "DC2", "DC12", "MD11", "MC13", "Linie 1", "L 3", "L 4", "Halle", "Kardex", "Allgemein")

'Check ob die Änderung auf einem relavanten Blatt war
For k = 0 To UBound(Blätter)
  If Blätter(k) = Sh.Name Then Exit For
Next k
If k > UBound(Blätter) Then Exit Sub  'Änderung war auf anderem Blatt

'Check ob die Änderung in Spalte F war
If Not Application.Intersect(Target.Cells(1), Sh.Range("F:F")) Is Nothing Then
  If Target.Cells.Count > 1 And Target.Cells(1) <> "" Then
    MsgBox "In Spalte F darf jeweils nur eine Zelle geändert werden. Die Aktion wird Rückgängig gemacht."
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
    Exit Sub
  End If
Else
  Exit Sub   'Änderung war nicht in Spalte F
End If

'Wenn Änderung im relevaten Bereich war dann Hier weiter
PrioAnz(1) = 1
PrioAnz(2) = 3
PrioAnz(3) = 5

If Target.Cells(1).Value > 0 And Target.Cells(1).Value < 4 Then
For k = 0 To UBound(Blätter)
  Summe = Summe + WorksheetFunction.CountIfs(Sheets(Blätter(k)).Range("F3:F1000"), Target.Value, Sheets(Blätter(k)).Range("G3:G1000"), Target.Offset(, 1).Value)
  If Summe > PrioAnz(Target.Value) Then
    MsgBox "Max Anzahl an Prio bereits vergeben. Die Aktion wird Rückgängig gemacht."
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
    Exit Sub
  End If
Next k
End If
End Sub

Gruß Elex

[Tommiks]

Guten Morgen Elex,

vielen Dank für die Hilfe.

Als Range sind die 1000 Zeilen vollkommen ausreichend.
 
ich teste immer an dem Namen "Vettel", und fange immer mit dem Arbeitsblatt, und mit der Priorität 1 an.
 
Ich darf für Vettel die Prio 1 bei DC1, CD1 jeweils 1-Mal vergeben. Das ist eine zu viel Prio 1 für Vettel. Erst ab CD2 wird mit einer Warnmeldung gestoppt.
Ich darf für Vettel die Prio 2 bei DC1, CD1 jeweils 3-Mal vergeben. Das ist drei Prio 2 zu viel für Vettel. Erst ab CD2 wird die Prio 2 mit einer Warnmeldung gestoppt.
Ich darf für Vettel die Prio 3 bei DC1 5-Mal vergeben, was in Ordnung ist, aber bei CD1 darf ich auch 4 Mal vergeben. Das ist weiterhin vier-Mal zu viel.
 
Die Datei mit der fehrlerhaften akzeptierten Prios packe ich bei.