Lösung für automatisches Ausrechnen

Hallo Zusammen,
ich habe immer noch folgendes Problem. Ich möchte ganz gerne eine Formel, die mir das tägliche manuelle ausrechnen abnimmt.
Es soll folgendes berechnet werden:
eine Anlage hat einen Fehler und ist nicht technisch Verfügbar
- erkennbar daran das in Spalte D ein "nein" steht
erst wenn jetzt von der Anlage ein System o.k. kommt( Status 0 ) dann soll die Ausfallzeit berechnet werden.
- erkennbar daran das in Spalte D ein "ja" steht
Die Meldungen werden täglich manuell eingefügt. Immer für ein Monat.
Es können unterschiedlich viele Meldungen von verschiedenen Anlagen kommen.
Problem dabei ist, daß zwischendurch mehrere Meldungen kommen können, halt auch von anderen Anlagen.
Wir filtern erst die Anlagen und rechnen dann die Ausfallzeit manuell aus.
Die Berechnung wird in Spalte J durchgeführt.
Zur Erklärung habe ich auch die Datei als Anhang beigefügt.
https://www.herber.de/bbs/user/19742.xls
Wer dann mal die Anlagen filtert kann genau sehen was wir ausrechnen.
- gerechnet wird von ein "nein" bis zum ersten System "o.k."!
Es haben sich schon mehrere daran versucht, aber bisher ohne Erfolg!
Wenn sich hier ein Profi bereit erklärt mir zu helfen, wäre ich sehr dankbar!!!!
Im voraus vielen Dank
Gruß
Tim

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Struppi,
ich weiß nicht, wie Du das wieder gut machen willst ;-)


Sub Berechne_Ausfallzeit()
Dim rg As Range
Dim lngCurRow As Long
Dim lngLastRow As Long
Dim lngCurAnlage As Long
Dim dteStart As Date
Dim dteEnde As Date
Dim dteDiff As Date
lngLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
Set rg = Range("A2", Cells.SpecialCells(xlCellTypeLastCell))
' Zunächst temporär die Anlage-Bereit Meldung in Statusmeldung übertragen
For lngCurRow = 2 To lngLastRow
If (Not IsDate(Cells(lngCurRow, "F"))) And (Not IsDate(Cells(lngCurRow, "G"))) Then
If IsDate(Cells(lngCurRow, "H")) And Len(Cells(lngCurRow, "I") & "") > 2 Then
Cells(lngCurRow, "F") = Cells(lngCurRow, "H")
Cells(lngCurRow, "G") = Cells(lngCurRow, "I")
End If
End If
Next lngCurRow
' Liste nach Anlage, Datum, Uhrzeit sortieren
rg.Sort Key1:=Range("E2"), _
Order1:=xlAscending, _
Key2:=Range("F2"), _
Order2:=xlAscending, _
Key3:=Range("G2"), _
Order3:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
' Startzeile
lngCurRow = 2
' Hier fängst an
Do While lngCurRow <= lngLastRow
If UCase(Range("D" & lngCurRow)) = UCase("Nein") Then
' Ausfall gefunden
lngCurAnlage = Range("E" & lngCurRow)
dteStart = CDate(Range("F" & lngCurRow).Text & " " & Range("G" & lngCurRow).Text)
' Jetzt Ende des Ausfalls suchen
Do
lngCurRow = lngCurRow + 1
If (lngCurRow <= lngLastRow) And (lngCurAnlage = Range("E" & lngCurRow)) Then
' Erst wurde geprüft, ob wir noch im definierten
' Bereich und in der aktuellen Anlage sind
If UCase(Range("D" & lngCurRow)) = UCase("Ja") Then
' Nach der jetzigen Sortierung sollte "Ja" stehen
dteEnde = CDate(Range("F" & lngCurRow).Text & " " & Range("G" & lngCurRow).Text)
dteDiff = dteEnde - dteStart
If Range("J" & lngCurRow).Text <> Format(dteDiff, "hh:mm") Then
Range("J" & lngCurRow) = Format(dteDiff, "hh:mm")
Range("J" & lngCurRow) = Format(dteDiff, "hh:mm")
End If
lngCurRow = lngCurRow + 1
Exit Do
End If
End If
Loop While (lngCurRow <= lngLastRow) And (lngCurAnlage = Range("E" & lngCurRow))
Else
lngCurRow = lngCurRow + 1
End If
Loop
' Liste wieder nach Datum und Uhrzeit sortieren
rg.Sort Key1:=Range("F2"), _
Order1:=xlAscending, _
Key2:=Range("G2"), _
Order2:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
'Fertig!!!
End Sub

Übringst hast Du einige Berechnungsfehler!
Viel Spaß
Frank.

Beliebteste Forumthreads (12 Monate)

Lösung für automatisches Ausrechnen

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Lösung für automatisches Ausrechnen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread