Hallo Pete,
wahrscheinlich hat die Forum-SW bei deiner Übertragung wieder einen gr0ßen Teil verschluckt. Du musst sicherheitshalber die Größer- und Kleinerzeichen im zu übertragenden Text durch etwas anderes ersetzen, weil die SW sie wohl teilweise als Steuerzeichen verwendet.
Ich schicke die noch einmal die vollständige Sub Messungen. Bei mir funktioniert sie so, wie ich dich verstanden habe:
Sub messungen_1()
Eingeben "Geben Sie den MinGrenzwert ein!", ming
ming = CDbl(Replace(ming, ".", ","))
Eingeben "Geben Sie den MaxGrenzwert ein!", maxg
maxg = CDbl(Replace(maxg, ".", ","))
Do
Eingeben "Geben Sie ein Datum Zeitraum von bis ein! (Format: tt.mm.jjjj - tt.mm.jjjj)", Datum
Loop Until InStr(Datum, "-")
Do
Eingeben "Geben Sie Uhrzeit Zeitraum von bis an! (Format: hh:mm:ss - hh:mm:ss", uhr
Loop Until InStr(uhr, "-")
Eingeben "Bitte geben Sie die Spalte an, in der Messwerte überprüft werden sollen.", sp
nName = Inputbox("Geben Sie ggf. den Namen für ein neues Tabellenblatt für die gefundenen " + _
"Werte ein. Wird kein Name eingegeben, wird kein neues Tabellenblatt angelegt")
If nName kleinergrößer "" Then
aName = activesheet.Name
Set NewSheet = worksheets.Add
NewSheet.Name = nName
Columns(1).NumberFormat = "m/d/yyyy"
Columns(2).NumberFormat = "[$-F400]h:mm:ss AM/PM"
Cells(1, 1) = "Datum"
Cells(1, 2) = "Uhrzeit"
Cells(1, 3) = "Messwert"
Sheets(aName).Activate
End If
dvon = CDate(Trim(Left(Datum, InStr(Datum, "-") - 1)))
dbis = CDate(Trim(Mid(Datum, InStr(Datum, "-") + 1)))
uvon = CDate(Trim(Left(uhr, InStr(uhr, "-") - 1)))
ubis = CDate(Trim(Mid(uhr, InStr(uhr, "-") + 1)))
Cells.Interior.ColorIndex = xlNone
sp = Columns(sp).Column
For i = 1 To Cells(Rows.Count, sp).End(xlUp).Row
a = Cells(i, 1)
b = Cells(i, 2)
If a + b größer= dvon + uvon And a + b kleiner= dbis + ubis Then
' If a größer= dvon And a kleiner= dbis And b größer= uvon And b kleiner= ubis Then
If Cells(i, sp) größer= ming And Cells(i, sp) kleiner= maxg Then
Cells(i, sp).Interior.Color = vbGreen
c = Sheets(nName).Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets(nName).Cells(c, 1) = Cells(i, 1)
Sheets(nName).Cells(c, 2) = Cells(i, 2)
Sheets(nName).Cells(c, 3) = Cells(i, sp)
Else
Cells(i, sp).Interior.Color = vbRed
End If
End If
Next i
End Sub
Gruß
Holger
Pete schrieb am 21.03.2009 20:24:06:
Hallo Holger,
ich scheitere immer beim Einfügen deines Prgrammes. Es erstellt zwar das neue Tabellenblatt aber die Spaltenüberschrift sowie die Auswertung wird nicht angezeigt.
Der grüne Bereich im Orginal tabellenblatt soll weiterhin erhalten bleiben.
Ich hab ja dein Programm geringfügig geändert. Hier das von mir abgeänderte Orginal, welches einwandfrei funktioniert.
Vielleicht siehst du den Fehler eher mit deinem geschulten Blick. Bin gespannt an was es liegt.
Sub Eingeben(text, wert)
Static t
t = text
Do
wert = InputBox(t, Messwerte, wert)
t = text + vbCrLf + "Geben Sie einen vernünftigen Wert ein!"
Loop While wert = ""
End Sub
Sub messungen()
Eingeben "Geben Sie den MinGrenzwert ein!", ming
ming = CDbl(Replace(ming, ".", ","))
Eingeben "Geben Sie den MaxGrenzwert ein!", maxg
maxg = CDbl(Replace(maxg, ".", ","))
Do
Eingeben "Geben Sie ein Datum Zeitraum von bis ein! (Format: tt.mm.jjjj - tt.mm.jjjj)", Datum
Loop Until InStr(Datum, "-")
Do
Eingeben "Geben Sie Uhrzeit Zeitraum von bis an! (Format: hh:mm - hh:mm)", uhr
Loop Until InStr(uhr, "-")
Eingeben "Bitte geben Sie die Spalte an, in der Messwerte überprüft werden sollen.", sp
dvon = CDate(Trim(Left(Datum, InStr(Datum, "-") - 1)))
dbis = CDate(Trim(Mid(Datum, InStr(Datum, "-") + 1)))
uvon = CDate(Trim(Left(uhr, InStr(uhr, "-") - 1)))
ubis = CDate(Trim(Mid(uhr, InStr(uhr, "-") + 1)))
Cells.Interior.ColorIndex = xlNone
sp = Columns(sp).Column
For i = 1 To Cells(Rows.Count, sp).End(xlUp).Row
a = Cells(i, 1)
b = Cells(i, 2)
If a >= dvon And a = uvon And b = ming And Cells(i, sp) <= maxg Then
Cells(i, sp).Interior.Color = vbGreen
Else
Cells(i, sp).Interior.Color = vbRed
End If
Next i
End Sub
Grüße Pete |