AW: Meldung bei Überschreitung einer Summe
23.08.2017 21:37:12
Christian
Hi,
hier noch eine Variante, die auf deiner Musterdatei aufbaut.
Du müsstest also noch die Eingabespalten die überwacht werden sollen
anpassen, ebenso die Zellen in denen die Summenformel stehen:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo eh
' Limit Anz. Aufträge
Dim lngLimit As Long
lngLimit = 20
' Wahrheitswert Schwelle überschritten
Dim blnLimitTouched As Boolean
blnLimitTouched = False
' Limit bei Eingaben in Spalte 2 (B) prüfen
If Not Intersect(ActiveSheet.Columns(2), Target) Is Nothing Then
' Summe in C2 prüfen
' Auf Limitüberschreitung prüfen
If Cells(2, 3) > lngLimit Then
blnLimitTouched = True
End If
End If
' Limit bei Eingaben in Spalte 5 (D) prüfen
If Not Intersect(ActiveSheet.Columns(5), Target) Is Nothing Then
' wie oben
If Cells(2, 6) > lngLimit Then
blnLimitTouched = True
End If
End If
' Limit bei Eingaben in Spalte 8 (H) prüfen
If Not Intersect(ActiveSheet.Columns(8), Target) Is Nothing Then
' wie oben
If Cells(2, 9) > lngLimit Then
blnLimitTouched = True
End If
End If
' Der Reihe nach alle Summenzellen auf Limitüberschreitung prüfen
' und Nachricht zusammenbauen
' Team A
If Cells(2, 3) > lngLimit Then
strMsg = "Limit von Team A überschritten"
End If
' Team B
If Cells(2, 6) > lngLimit Then
If Not strMsg = "" Then
' Nachricht muss erweitert werden
strMsg = strMsg & vbCrLf & "Limit von Team B überschritten"
Else
' Nachricht beginnt, da 1. Fehler
strMsg = "Limit von Team B überschritten"
End If
End If
' Team C
If Cells(2, 9) > lngLimit Then
If Not strMsg = "" Then
' Nachricht muss erweitert werden
strMsg = strMsg & vbCrLf & "Limit von Team C überschritten"
Else
' Nachricht beginnt, da 1. Fehler
strMsg = "Limit von Team C überschritten"
End If
End If
' Nachricht ausgeben, wenn Limit in einem der Teams gebrochen wurde
If blnLimitTouched = True Then
MsgBox strMsg
End If
End Sub
VG, Ch.