Office: Warnfenster nach If-Schleife einblenden

Excel_beginner · 4. Juli 2014

Aaaah, haha, ja jetzt verstehe ich was du meinst! Okay, ich habe mich nicht ganz genau ausgedrückt. Aber deine Lösung ist sogar noch besser *Smilie

Was ich ursprünglich meinte war: Einen Bereich zu wählen, der immer bei glatten 100ern anfängt.
Bereich 1: 1600-1699
Bereich 2: 1700- 1799... usw.

Und dann schauen ob in dem Bereich 5 Messwerte liegen. Ich habe nichtmal daran gedacht, die Bereiche immer über 4 Messwerte zu ziehen. Deine Lösung ist definitiv deutlich besser, an sowas hätte ich nie gedacht. Super, ganz vielen Dank, das hat mir sehr geholfen, allein hätte ich das nie hinbekommen!

*THUMBS UP*

Excel_beginner · 4. Juli 2014

Klaro, jetzt wenn ich drüber nachdenke, wäre meine Lösung nicht gut gewesen.

Hätte jemand das Knöpfchen ganz schnell gedreht wären ganze Sprünge von bspw...

1500
1510
1520
1530
1540
2310
2320
2340
2360
2370

unter Umständen nichtmal aufgefallen.

Excel_beginner · 4. Juli 2014

Hallo Hasso,

ich baue gerade deinen Code in mein gesamtes Arbeitsblatt ein, wobei ich auf ein Problem gestoßen bin.

Im prinzip nehme ich nur deinen Code und kopiere ihn bis auf den Knopf in mein Modul, allerdings bekomme ich jetzt einen "Überlauf" fehler in Zeile:

intZeile = intZeile + 1.

Code:

Option Explicit

Sub Check_RPM_increase(wsName As String)
Dim ws As Worksheet
Dim lngLetzte As Long
'Check if worksheet is already created, otherwise delete
If Not IsError(Evaluate(wsName & "!A1")) Then
Application.DisplayAlerts = False
Worksheets(wsName).delete
Application.DisplayAlerts = True
End If
'Create new worksheet
ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
'Choose Name
ActiveSheet.Name = wsName
'Your code for manipulating the data
Application.ScreenUpdating = False
Worksheets("Process_Data").Columns("A:D").Copy Destination:=ThisWorkbook.Worksheets("Check_RPM_increase").Range("A:D")
Application.CutCopyMode = False
Application.ScreenUpdating = True
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)

'Code for finding delta rpm > 100rpm
Dim rngZelle As Range
Dim intZeile As Integer
Dim intSpalte As Integer
Dim intLetzteZeile As Integer
Dim intZaehler As Integer
Dim intErhoehung As Integer

'letzte Zeile in Spalte C ermitteln:
intLetzteZeile = Worksheets("Process_Data").Cells(Rows.Count, "C").End(xlUp).Row
'alte Färbungen löschen:
Worksheets("Process_Data").UsedRange.Interior.ColorIndex = xlNone
'alle Zellen in Spalte C durchgehen:
For Each rngZelle In Worksheets("Process_Data").Range("C3:C" & intLetzteZeile - 4)
intErhoehung = 0
intZeile = 1
intZaehler = 0
Do
intErhoehung = Cells(rngZelle.Row + intZeile, "C") - Cells(rngZelle.Row, "C")
intZeile = intZeile + 1
intZaehler = intZaehler + 1
Loop Until intErhoehung > 100
'wenn wenige als 5 Messwerte, die Zellen rot färben:
If intZaehler < 4 Then Range("C" & rngZelle.Row & ":C" & rngZelle.Row + intZaehler).Interior.Color = RGB(255, 0, 0)
Next rngZelle

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich habe an dem Code nichts verändert außer, dass ich erst die Werte in ein anderes Worksheet copiere und dann deinen Code ausführe. Es tut mir leid, dass ich damit schon wieder anfange :/

Hasso · 4. Juli 2014

Hallo Excel_beginner,

wie viele Zeilen hat denn dein Blatt? Vielleicht solltest du statt Code:

Dim intZeile As Integer
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

lieber Code:

Dim lngZeile As Long
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

nehmen.

Excel_beginner · 4. Juli 2014

Mein Blatt hat 212 Zeilen mit Daten und geht insgesamt bis 350, die Zeilen dazwischen sind in dem Bereich leer.

Ich habe meine WS Namen abgepasst und die Variable auch, der Fehler besteht immernoch.

Wenn ich im Debugger Modus den cursor auf intZaehler halte in der Fehlerhaften Zeile, steht der Wert auf 32767... Dann verstehe ich, dass er nicht noch einen aufaddieren kann.

Hast du eine Idee warum der Zaehler so hoch ist ?

Hasso · 4. Juli 2014

Aus dem Code ersehe ich das nicht. Kannst du mal die Mappe hochladen?

Excel_beginner · 4. Juli 2014

So, musste eben alles löschen was nicht dazugehört.

Wenn du auf der STARTseite den großen Knopf drückst, dann tritt das Problem auf. Es wird die neue Seite geöffnet und es hängt.

Hasso · 4. Juli 2014

warum ist der Messwert in Zeile 212 so viel kleiner (-244) als der vorhergehende?

Excel_beginner · 4. Juli 2014

Die Messung wird per Hand von zwei Personen gestartet und gestoppt. Dabei kann es schnell passieren, dass der Prüfstandsfahrer die Drehzahl runterfährt, bevor das Programm letzten Werte geschrieben hat.

Hasso · 4. Juli 2014

Hallo Excel_beginner,

das Problem lag daran, dass am Ende der Tabelle nie der Wert 100 überschritten wurde und das Programm in der Do ... Loop Schleife hängen blieb.

Ich habe das im Code jetzt abgefangen und das Makro läuft ohne Fehler durch: Code:

'Code for finding delta rpm > 100rpm
Dim rngZelle As Range
Dim lngZeile As Long
Dim intSpalte As Integer
Dim intLetzteZeile As Integer
Dim intZaehler As Integer
Dim intErhoehung As Integer

With Worksheets("Check_RPM_increase")
'letzte Zeile in Spalte C ermitteln:
intLetzteZeile = .Cells(Rows.Count, "C").End(xlUp).Row
'alte Färbungen löschen:
.UsedRange.Interior.ColorIndex = xlNone
'alle Zellen in Spalte C durchgehen:
For Each rngZelle In .Range("C3:C" & intLetzteZeile - 4)
intErhoehung = 0
lngZeile = 1
intZaehler = 0
Do
'wenn die erste leere Zelle in Spalte C erreicht wurde, ohne dass intErhoehung>100 ist (Endlosschleife):
If .Cells(rngZelle.Row + lngZeile, "C") = 0 Then Exit Sub
intErhoehung = .Cells(rngZelle.Row + lngZeile, "C") - .Cells(rngZelle.Row, "C")
lngZeile = lngZeile + 1
intZaehler = intZaehler + 1
Loop Until intErhoehung > 100
'wenn weniger als 5 Messwerte, die Zellen rot färben:
If intZaehler < 4 Then .Range("C" & rngZelle.Row & ":C" & rngZelle.Row + intZaehler).Interior.Color = RGB(255, 0, 0)
Next rngZelle
End With
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

So, und jetzt ist erst mal Fußball angesagt *biggrin.gif*

Excel_beginner · 4. Juli 2014

jaaaaah, jetzt funktioniert alles genau so wie ich es brauche!

Weltklasse, danke!!

Office: Warnfenster nach If-Schleife einblenden

Warnfenster nach If-Schleife einblenden

Warnfenster nach If-Schleife einblenden

Warnfenster nach If-Schleife einblenden

Warnfenster nach If-Schleife einblenden

Warnfenster nach If-Schleife einblenden - Similar Threads - Warnfenster Schleife einblenden

Verkettung von Zellen - Schleife

While-Schleife wird nicht beendet

For Next Schleife

VBA Schleife kopieren und einfügen von Spalten

Eine Schleife mit zwei tebellen vba Access

Bestimmte Daten zwischen innerhalb eines Datumsbereichs einer Tabelle Anfügen

VBA Loop : Werte suchen und löschen