AW: MsgBox nur einmal anzeigen
18.01.2018 14:41:33
UweD
Hallo
so?
in ein Modul
Option Explicit
Public Nureinmal1 As Integer
Public Nureinmal2 As Integer
Public Nureinmal3 As Integer
Public Const RNG1 As String = "AB41:AB46"
Public Const RNG2 As String = "AB16:AB19"
Public Const RNG3 As String = "AB29:AB30"
Public Const Ru1 As Integer = 100
Public Const Ru2 As Integer = 1000
Public Const Ru3 As Integer = 2500
ins Blatt
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With WorksheetFunction
If Not Intersect(Range(RNG1), Target) Is Nothing Then
Nureinmal1 = .Max(Ru1, .RoundUp(.Sum(Range(RNG1)) / Ru1, 0) * Ru1)
End If
If Not Intersect(Range(RNG2), Target) Is Nothing Then
Nureinmal2 = .Max(Ru2, .RoundUp(.Sum(Range(RNG2)) / Ru2, 0) * Ru2)
End If
If Not Intersect(Range(RNG3), Target) Is Nothing Then
Nureinmal3 = .Max(Ru3, .RoundUp(.Sum(Range(RNG3)) / Ru3, 0) * Ru3)
End If
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Summe As Integer
With WorksheetFunction
If Not Intersect(Range(RNG1), Target) Is Nothing Then
Summe = .Sum(Range(RNG1))
If Summe > Nureinmal1 Then
MsgBox ("Probe für " & Ru1 & "er: " & Summe)
Nureinmal1 = .RoundUp(Summe / Ru1, 0) * Ru1
ElseIf Summe = 0 Then
Nureinmal1 = Ru1 'Bei Start oder nach Reset
End If
End If
If Not Intersect(Range(RNG2), Target) Is Nothing Then
Summe = .Sum(Range(RNG2))
If Summe > Nureinmal2 Then
MsgBox ("Probe für " & Ru2 & "er: " & Summe)
Nureinmal2 = .RoundUp(Summe / Ru2, 0) * Ru2
ElseIf Summe = 0 Then
Nureinmal2 = Ru2 'Bei Start oder nach Reset
End If
End If
If Not Intersect(Range(RNG3), Target) Is Nothing Then
Summe = .Sum(Range(RNG3))
If Summe > Nureinmal3 Then
MsgBox ("Probe für " & Ru3 & "er: " & Summe)
Nureinmal3 = .RoundUp(Summe / Ru3, 0) * Ru3
ElseIf Summe = 0 Then
Nureinmal3 = Ru3 'Bei Start oder nach Reset
End If
End If
End With
End Sub