Beregning af stoptid, driftstid m.m.
På siden Beregning af tid har jeg vist eksempler på beregning af tid med Excel VBA makroer.
Denne side viser et praktisk eksempel på, hvordan man kan beregne antal stop, start, stoptid, driftstid, gennemsnitlig tid mellem hvert stop o.l. Den slags statistik er meget almindelig i industrien som mål for processens effektivitet.
Det kunne også være en vognmand, der vil holde styr på køre- og hviletid - der er mange anvendelsesmuligheder, når det i bund og grund drejer sig om at beregne forløben tid mellem tidspunkter.
Ved at lave det i Excel kan man nemt skræddersy tingene til særlige behov - forudsætningen er blot, at man kan få tidspunkter m.m. ind i Excel.
Eksemplet på denne side bruger VBA-funktionen DateDiff til at beregne tidsforskelle og bruger desuden løkker, ranges, arrays og en collection.
Du kan downloade et regneark med eksemplet her (kommentarer på engelsk), eller du kan markere og kopiere koden længere nede på siden.
I eksemplet er "loggen" en simpel tabel med 3 kolonner. De ældste logninger står øverst, og jeg har fremtidssikret koden ved at bruge år 2020.
Motor Date Status
MOTOR1 01-01-2020 02:40:04 STOP
MOTOR1 01-01-2020 02:42:04 START
MOTOR1 01-01-2020 11:31:44 STOP
MOTOR1 01-01-2020 12:21:24 START
MOTOR1 01-01-2020 18:56:14 STOP
MOTOR1 01-01-2020 18:58:14 START
MOTOR2 02-01-2020 09:47:24 STOP
MOTOR2 02-01-2020 10:45:24 START
Osv.
Der kan sagtens være flere kolonner, de kan stå i en anden rækkefølge, der kan være flere motorer eller produktionslinjer, men jeg har valgt et simpelt eksempel for overskuelighedens skyld.
I celle G2 og ned kan man angive, hvilke maskiner der skal søges på (her MOTOR1 og/eller MOTOR2). Makroen finder antal stop i alt, antal starter, samlet stoptid, samlet driftstid, gennemsnitlig tid mellem hvert stop samt tid i alt fra første til sidste logning - altså periodens længde.
Til at beregne forskellen mellem to tidspunkter i sekunder bruges VBA-funktionen DateDiff:
Tidsforskel = DateDiff("s", Ældste tid, Nyere tid)
Makroen har 3 løkker. Den ydre løkke gennemløber loggen for hver motor, som står i celle G2 og ned. Er der kun valgt 1 motor, bliver der kun 1 gennemløb.
Den indre løkke gennemløber rækkerne fra oven, indtil cellen i kolonne A matcher den aktuelle motor, og status er "STOP".
Når den betingelse er opfyldt, startes en ny løkke, som løber nedad, til cellen i kolonne A matcher motoren, og status i kolonne C er "START".
Derefter beregnes tidsforskellen mellem stop og start.
Undervejs tæller makroen antal stop og start, og til slut beregnes de forskellige ting, og tabeller indsættes på faneblad 2.
For at speede hastigheden op, kopieres tabellen med logdata til et array med de samme dimensioner. Man kunne sagtens operere på tabellen som et range, men det går hurtigere med et array.
Nå, lad os komme i gang!
Sub Calculate()
Dim bStart As Boolean
Dim bStop As Boolean
Dim rCell As Range
Dim rTable As Range
Dim arInput()
Dim lCount As Long
Dim lRow As Long
Dim lRow2 As Long
Dim lDualStart As Long
Dim lDualStop As Long
Dim lLastRow As Long
Dim lTimeDiff As Long
Dim lStarts As Long
Dim lStops As Long
Dim lTotaltime As Long
Dim dStopTime As Double
Dim colMotor As New Collection
On Error GoTo ErrorHandle
Worksheets(1).Activate
Set rTable = Range("A2", Range("A2").End(xlToRight))
If Len(Range("A3").Value) = 0 Then
MsgBox "Tabellen har kun én række."
GoTo BeforeExit
End If
Set rTable = Range(rTable, rTable.End(xlDown))
arInput = rTable.Value
Set rTable = Range("G2")
If Len(rTable.Value) = 0 Then
MsgBox "Celle G2 og ned skal indeholde mindst 1 motornavn."
GoTo BeforeExit
End If
If Len(rTable.Offset(1, 0).Value) > 0 Then
Set rTable = Range(rTable, rTable.End(xlDown))
End If
On Error Resume Next
For Each rCell In rTable
colMotor.Add rCell.Value
Next
On Error GoTo ErrorHandle
lLastRow = UBound(arInput)
lTotaltime = DateDiff("s", arInput(1, 2), arInput(lLastRow, 2))
With colMotor
For lCount = 1 To .Count
lStarts = 0
lStops = 0
dStopTime = 0
lDualStop = 0
lDualStart = 0
For lRow = 1 To lLastRow
If arInput(lRow, 1) = .Item(lCount) Then
If arInput(lRow, 3) = "START" And lStops = 0 Then
bStart = True
lStops = 1
lStarts = 1
If lRow > 1 Then
lTimeDiff = DateDiff("s", arInput(lRow, 2), arInput(1, 2))
dStopTime = lTimeDiff
End If
End If
If arInput(lRow, 3) = "START" And bStart Then
lDualStart = lDualStart + 1
lStarts = lStarts + 1
End If
If arInput(lRow, 3) = "STOP" Then
bStop = True
bStart = False
lStops = lStops + 1
For lRow2 = lRow + 1 To lLastRow
If arInput(lRow2, 3) = "START" And _
arInput(lRow2, 1) = .Item(lCount) Then
lTimeDiff = DateDiff("s", arInput(lRow, 2), _
arInput(lRow2, 2))
dStopTime = dStopTime + lTimeDiff
lRow = lRow2
bStop = False
bStart = True
lStarts = lStarts + 1
Exit For
End If
If arInput(lRow2, 3) = "STOP" And _
arInput(lRow2, 1) = .Item(lCount) Then
lDualStop = lDualStop + 1
End If
If lRow2 = lLastRow And bStart = False And bStop Then
lTimeDiff = DateDiff("s", arInput(lRow, 2), _
arInput(lLastRow, 2))
dStopTime = dStopTime + lTimeDiff
End If
Next
End If
End If
Next
WriteResult lStops, lStarts, dStopTime, _
lTotaltime, lCount, .Item(lCount)
If lDualStart > 0 Then
MsgBox "Der er logget " & & lDualStart * 2 & " START uden stop." _
& vbNewLine & _
"De beregnede tider for " & .Item(lCount) & " er derfor usikre."
End If
If lDualStop > 0 Then
MsgBox "Der er logget " & lDualStop * 2 & _
"STOP uden start imellem." & vbNewLine & _
"De beregnede tider for " & .Item(lCount) & " er derfor usikre."
End If
Next
End With
BeforeExit:
On Error Resume Next
Erase arInput
Set colMotor = Nothing
Set rTable = Nothing
Set rCell = Nothing
Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure Calculate"
Resume BeforeExit
End Sub
Sub WriteResult(ByVal lStops As Long, ByVal lStarts As Long, _
ByVal dStopTime As Double, ByVal lTotaltime As Long, _
ByVal lCount As Long, ByVal sMotor As String)
Dim arOutput(1 To 6, 1 To 3)
Dim rInsert As Range
Dim lStep As Long
Dim lRow As Long
On Error GoTo ErrorHandle
Application.ScreenUpdating = False
arOutput(1, 1) = "Stop " & sMotor
arOutput(2, 1) = "Starter " & sMotor
arOutput(3, 1) = "Total stoptid"
arOutput(4, 1) = "Total driftstid"
arOutput(5, 1) = "Gennemsnitlig tid mellem stop"
arOutput(6, 1) = "Hele periodens længde"
arOutput(1, 2) = lStops
arOutput(2, 2) = lStarts
arOutput(3, 2) = dStopTime / 3600
arOutput(4, 2) = (lTotaltime - dStopTime) / 3600
arOutput(5, 2) = lTotaltime / 3600 / lStops
arOutput(6, 2) = lTotaltime / 3600
arOutput(3, 3) = "Timer"
arOutput(4, 3) = "Timer"
arOutput(5, 3) = "Timer"
arOutput(6, 3) = "Timer"
Worksheets(2).Activate
If lCount = 1 Then
Cells.ClearContents
Set rInsert = Range("A1")
Else
For lStep = 1 To lCount
lRow = lStep + 6
Next
Set rInsert = Range("A" & lRow)
End If
Set rInsert = Range(rInsert, rInsert.Offset(5, 2))
rInsert.Value = arOutput
BeforeExit:
On Error Resume Next
Erase arOutput
Set rInsert = Nothing
Application.ScreenUpdating = True
Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure WriteResult"
Resume BeforeExit
End Sub
Det var det - et eksempel på beregning af tid med betingelser. Man kan nemt lave om på kolonnerne og tilføje ting, ligesom man fx kan lægge betingelser ind, om at stop under en given varighed skal ignoreres.
Styrken ved at bruge Excel VBA i stedet for en eller anden standardløsning er netop, at man kan skræddersy tingene, så de passer præcis til ens behov.
Relateret:
|