Schwellwerte im Messbereich
15.01.2007 13:17:20
sandro
ich habe folgendes problem und ich hoffe ihr könnt mir helfen.
es werden von einer maschine automatisch messwerte in bestimmte zellen eingefügt.(F16-unendlich)
jetzt habe ich die aufgabe diese messwerte mit folgenden anforderungen in ein diagramm zu übernehmen:
1. Wird der Wert 50 - 10mal hintereinander überschritten kommt eine msgbox.
jetzt ist es so das wenn der wert insgesamt(über den ganzen bereich) 10 mal überschritten wird erscheint die msgbox.
2. Wenn zb.: F17 leer bleibt und bei F18 ein datensatz hineingeschrieben wird sollte in F17 automatisch der wert 55 geschrieben werden.
3. Sollte die Messung einen Wert unter -10 ergeben sollte eine msgbox erscheinen.
ich habe das bis jetzt so weit:
ein modul:
Option Explicit
Const DR_COLUMN = 6 'hier Spalte F
Const DR_ROW = 16
Const DUMMYVALUE = 55
Const SCHWELLE = 50
Const HSCHWELLE = 10
Sub ReDrawDiagramm()
Dim ws As Worksheet, maxRow As Long
Dim c As Range, countXplus As Integer
Set ws = Worksheets("INDIVIDUAL")
maxRow = ws.Cells(Rows().Count, DR_COLUMN).End(xlUp).Row
'Routine zur Festellung ob Werte gesetzt sind und
'wie of der Wert X überschritten wurde
For Each c In Range(Cells(DR_ROW, DR_COLUMN), Cells(maxRow, DR_COLUMN))
If c.Value = "" Then c.Value = DUMMYVALUE
If c.Value >= SCHWELLE Then countXplus = countXplus + 1 'ggf vor Leerzellenauffüllung setzen
Next
ActiveWorkbook.Names.Add Name:="Diagrammdaten1", RefersToR1C1:= _
"=" & ws.Name & "!R" & DR_ROW & "C" & DR_COLUMN & ":R" & maxRow & "C" & DR_COLUMN
If countXplus > HSCHWELLE Then
Beep
Beep
MsgBox countXplus & " Messwerte überschreiten den Grenzwert " & SCHWELLE & "! BITTE EINSTELLER KONTAKTIEREN!!!"
Beep
End If
End Sub
und im file:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static prevAdr As String
Dim currAdr As String
currAdr = Target.Address
If Target.Column = DR_COLUMN Then
ReDrawDiagramm
End If
prevAdr = currAdr
End Sub
danke im voraus!!!!