RSS

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. Smiley

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         'Flag for start
Dim bStop As Boolean          'Flag for stop
Dim rCell As Range            'Range variabel
Dim rTable As Range           'Tabellen med logdata
Dim arInput()                 'Arrayet med logdata
Dim lCount As Long            'Tæller
Dim lRow As Long              'Tæller
Dim lRow2 As Long             'Tæller
Dim lDualStart As Long        'Tæller starter uden stop
Dim lDualStop As Long         'Tæller stop uden start
Dim lLastRow As Long          'Antal rækker i arrayet/tabellen
Dim lTimeDiff As Long         'Tidsforskel mellem stop/start
Dim lStarts As Long           'Antal starter
Dim lStops As Long            'Antal stop
Dim lTotaltime As Long        'Tid mellem første og sidste logning
Dim dStopTime As Double       'Total stoptid
Dim colMotor As New Collection 'Collection til motornavne

On Error GoTo ErrorHandle

Worksheets(1).Activate

'Tabellens første række
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

'Udvid rTable
Set rTable = Range(rTable, rTable.End(xlDown))

'Kopiér tabellen til arrayet. Det gør vi, fordi
'det er hurtigere at operere på et array.
'Arrayet får automatisk de samme dimensioner
'som tabellen.
arInput = rTable.Value

'Første motornavn
Set rTable = Range("G2")

If Len(rTable.Value) = 0 Then
   MsgBox "Celle G2 og ned skal indeholde mindst 1 motornavn."
   GoTo BeforeExit
End If

'Hvis der er mere end 1 motor,udvider vi rTable.
If Len(rTable.Offset(1, 0).Value) > 0 Then
   Set rTable = Range(rTable, rTable.End(xlDown))
End If

'For at sikre unikke navne, putter vi dem i en
'collection. Prøver man at tilføje en allerede
'eksisterende nøgle til en collection, udløser
'det en fejl, og derfor skriver vi:
'On Error Resume Next
'Det med at undgå dubletter er ikke strengt
'nødvendigt, og man kan sagtens undlade det.
'Det er blot med for eksemplets skyld.
'Hvis man dropper collection'en, kan man
'i stedet gennemløbe ranget med motornavne
'i den ydre løkke.
On Error Resume Next

For Each rCell In rTable
   colMotor.Add rCell.Value
Next

On Error GoTo ErrorHandle

'For nemheds skyld gemmer vi antallet af
'rækker i en variabel.
lLastRow = UBound(arInput)

'Nu beregner vi hele periodens længde, dvs. antal
'sekunder fra første til sidste række.
lTotaltime = DateDiff("s", arInput(1, 2), arInput(lLastRow, 2))

'Nu starter vi den ydre løkke, som gennemløber vores
'collection med motornavne. For hver motor gennemløbes
'arrayet med endnu en løkke. Den ældste logning er i 1.
'række, så vi gennemløber fra top til bund.
With colMotor
   'Gennemløb motor-collection
   For lCount = 1 To .Count
      lStarts = 0
      lStops = 0
      dStopTime = 0
      lDualStop = 0
      lDualStart = 0
      
      'Indre løkke som gennemløber rækkerne
      For lRow = 1 To lLastRow
         'Hvis motoren i første kolonne matcher motoren,
         'vi søger på.
         If arInput(lRow, 1) = .Item(lCount) Then
            'Hvis den startes, før vi har en stop-logning,
            'må den have været stoppet indtil nu, og stoptiden
            'fra 1. række til nu beregnes.
            If arInput(lRow, 3) = "START" And lStops = 0 Then
               bStart = True
               lStops = 1
               lStarts = 1
               'Hvis det ikke er 1. række, beregnes
               'stoptiden fra 1. række
               If lRow > 1 Then
                  lTimeDiff = DateDiff("s", arInput(lRow, 2), arInput(1, 2))
                  dStopTime = lTimeDiff
               End If
            End If
            'Hvis bStart er TRUE, og der er en ny start,
            'er der et stop, som ikke er blevet logget.
            'Det gør beregningen af stoptid m.m. upålidelig,
            'og for at kunne gøre opmærksom på det,
            'lægges der 1 til tælleren lDualStart.
            If arInput(lRow, 3) = "START" And bStart Then
               lDualStart = lDualStart + 1
               lStarts = lStarts + 1
            End If
            'Hvis der er stop på motoren
            If arInput(lRow, 3) = "STOP" Then
               bStop = True   'Sæt flag
               bStart = False 'Sæt flag
               'Opdater antal stop
               lStops = lStops + 1
               
               'Nu startes en indre løkke fremad for at finde
               'næste start
               For lRow2 = lRow + 1 To lLastRow
                  'Hvis motoren blev startet
                  If arInput(lRow2, 3) = "START" And _
                  arInput(lRow2, 1) = .Item(lCount) Then
                     'Vi beregner stoptiden
                     lTimeDiff = DateDiff("s", arInput(lRow, 2), _
                     arInput(lRow2, 2))
                     'Læg stoptiden til totalstoptiden
                     dStopTime = dStopTime + lTimeDiff
                     'lRow sættes = lRow2 for at springe frem
                     lRow = lRow2
                     bStop = False  'Flag
                     bStart = True  'Flag
                     'Opdatér antal starter
                     lStarts = lStarts + 1
                     'Forlad den indre løkke
                     Exit For
                  End If
                  'Hvis vi støder på endnu et STOP, har der været en start,
                  'som ikke er blevet logget, og vi lægger 1 til tælleren
                  'lDualStop.
                  If arInput(lRow2, 3) = "STOP" And _
                  arInput(lRow2, 1) = .Item(lCount) Then
                     lDualStop = lDualStop + 1
                  End If
                  'Hvis vi er kommet til sidste række uden at have fundet
                  'en start, var motoren stadig stoppet, da den sidste række
                  'blev logget, så vi lægger stoptiden fra sidste stop til
                  'sidste række til den totale stoptid.
                  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
      
      'Kald WriteResult for at skrive en lille
      'tabel med resultaterne.
      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)
'Skriver en tabel med stoptider osv. til Ark2.
'Sekunder omregnes til timer.

Dim arOutput(1 To 6, 1 To 3)  'Array til outputtabel
Dim rInsert As Range          'Range til tabel
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

'Hvis det er den første motor i vores collection,
'starter tabellen i celle A1. Ellers finder vi
'tabellens startcelle længere nede.
If lCount = 1 Then
   'Hvis det er den første motor, slettes gamle tabeller
   Cells.ClearContents
   Set rInsert = Range("A1")
Else
   For lStep = 1 To lCount
      lRow = lStep + 6
   Next
   Set rInsert = Range("A" & lRow)
End If

'Definér tabellens range
Set rInsert = Range(rInsert, rInsert.Offset(5, 2))

'Kopierer arrayet til ranget i ét hug
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: