Kunne en vel kommenteret/struktureret "færdig-løsning" accepteres?

Hvilen filtype er "rådata"?

Hej Supertekst

Naturligvis kan en kommenteret løsning accepteres ;o)

Data ligger i en rå tekstfil.

Ok - har du mulighed for at sende en kopi af denne fil?

Mailadr. under profil.

Hej Supertekst

Du kan også få den her:

        timestample        | machineid |  cardid  | balance | option | price | state | weigth | program |  tenantid  | doy | month | dow | hour
----------------------------+-----------+----------+---------+--------+-------+-------+--------+---------+--------------+-----+-------+-----+------
2010-02-09 02:15:01.292+01 |        0 | 17038450 |        |        |    0 |    6 |        |        | 605000000908 |  40 |    2 |  2 |    2


Den vil så ligge en i tekstfil dog med nogle flere poster ;o)

Hej igen

Jeg har sendt dig en mail med lidt mere data ;o)

Hej Peter

Det er modtaget og ser rigtig fint ud....

Nu ville jeg jo gerne at den så kunne:

Sortere på maskine nr.
og samle posterne efter timefordeling.

Klokketime(hour)
00: 1 start
01: 3 starter etc.

Starter pr. dag:
DOY: Starter pr. maskine pr. dag

Rem Version 2 - 12/3-10
Rem ===================
Const tekstFilNavn = "output.test.txt"
Const hour0kolonne = 15                            'kolonne "O"

Const systemArkNavn = "System"
Dim arkSys As Worksheet

Dim arkTot As Worksheet
Const totalArkNavn = "Totaler"

Dim tekstFilMappe As String

Dim ræk As Long, kolonne As Byte, antalRækker As Long
Public Sub IndlæsOgOrganiser()
On Error GoTo fejl

    Set arkSys = ActiveWorkbook.Sheets(systemArkNavn)
    arkSys.Activate
   
    nulstilData                                    'kalder sub-rutinen, "som navnet siger"
   
    findMappeMedTekstfil                            'kalder sub-rutinen, "som navnet siger"
   
    ræk = 1                                        'start-række for de indlæste data
    kolonne = 1                                    'start-kolonne -"-
   
    Application.ScreenUpdating = False              'slå skærm opdatering fra
   
    indlæsTekstFil                                  'kalder sub-rutinen, "som navnet siger"
   
    sorterIflgMaskine
   
    optællingPrMaskine
   
    Columns.AutoFit                                'tilpas kolonnebredde
   
    opbygTotaler
   
    Application.ScreenUpdating = True

    Exit Sub
   
fejl:
    Stop
    Resume Next
End Sub
Private Sub findMappeMedTekstfil()
    On Error GoTo fejl1
   
    Application.Dialogs(xlDialogOpen).Show
        tekstFilMappe = CurDir
       
        If Right(tekstFilMappe, 1) <> "\" Then
            tekstFilMappe = tekstFilMappe + "\"
        End If
    Exit Sub
   
fejl1:
    Resume Next
End Sub
Private Sub nulstilData()
    Range("A2:IV65000").Select
    Selection.ClearContents
    Range("A1").Select
End Sub
Private Sub indlæsTekstFil()
Dim linje As String
    Open tekstFilMappe + tekstFilNavn For Input As #1        'åbner inddata filen - tekstfiler identificeres med et nr (#1)
   
Rem Læs overskrift fra linje 1 - spring linje 2 over
        Input #1, linje                            'læs en hel linje ind (overskriften)
        indsætIregneArk linje                      'kalder sub-rutinen, "som navnet siger" - indlæste linje overføres
        Input #1, linje                            'indlæs linje 2 (skal ikke anvendes)
       
Rem læs resten indtil EOF
        While Not EOF(1)                            'sålænge der er linjer - læs & indsæt
            Input #1, linje
            indsætIregneArk linje                  'kalder sub-rutinen, "som navnet siger" - indlæste linje overføres
        Wend
    Close #1                                        'lukker tekstfilen
   
    antalRækker = ræk - 1
End Sub
Private Sub indsætIregneArk(linje)
Dim opdeltLinje As Variant, del As Byte
    opdeltLinje = Split(linje, "|")                'den indlæste linje opsplittes efter "|"
   
    For del = 0 To UBound(opdeltLinje)              'opdeltlinje indeholder nu et "antal rum", der er bestemt af opsplitningen
        Cells(ræk, kolonne) = Trim(opdeltLinje(del)) 'hvert "rum" indsættes i regnearket
        kolonne = kolonne + 1
    Next del
   
    ræk = ræk + 1                                  'alle "rum" indsæt - forøg rækkenr - reset kolonne
    kolonne = 1
End Sub
Private Sub sorterIflgMaskine()                    'sorter området: A2-Nsidsterække / Feltet MaskinNr
    Range("A2:N" & CStr(antalRækker)).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End Sub
Private Sub optællingPrMaskine()                    'timeNr anvendes til placering af 1-tal
Dim timeNr As Byte
    For ræk = 2 To antalRækker
        timeNr = Cells(ræk, 14)
        pt = Cells(ræk, hour0kolonne + timeNr).Value
        Cells(ræk, hour0kolonne + timeNr).Value = Cells(ræk, hour0kolonne + timeNr).Value + 1
    Next ræk
End Sub
Private Sub opbygTotaler()                          'opbygges på arket Totaler
Dim maskinnr As Integer, totalRække As Integer, fraKolonne As Byte

    Set arkTot = ActiveWorkbook.Sheets(totalArkNavn)
   
    nulstilTotArk
   
    totalRække = 2
   
    For ræk = 2 To antalRækker
        fraKolonne = hour0kolonne
   
        If ræk = 2 Then
            maskinnr = Cells(ræk, 2)                'kolonne B
            overførTilTotArk maskinnr, ræk, totalRække, fraKolonne
        Else
            If Cells(ræk, 2) = maskinnr Then
                overførTilTotArk maskinnr, ræk, totalRække, fraKolonne
            Else
                maskinnr = Cells(ræk, 2)
                totalRække = totalRække + 1
                overførTilTotArk maskinnr, ræk, totalRække, fraKolonne
            End If
        End If
    Next ræk
   
    indsætTotalFormler totalRække + 1
End Sub
Private Sub nulstilTotArk()                        'slet indhold af totallinier
    arkTot.Range("A2:Z1000").ClearContents
End Sub
Private Sub overførTilTotArk(maskinnr As Integer, ræk As Long, totalRække As Integer, fraKolonne As Byte)
Dim totalkolonne As Byte
    With arkTot
        .Cells(totalRække, 1) = maskinnr
       
        For totalkolonne = 2 To 25
            .Cells(totalRække, totalkolonne).Value = .Cells(totalRække, totalkolonne).Value + arkSys.Cells(ræk, fraKolonne).Value
            fraKolonne = fraKolonne + 1
        Next totalkolonne
    End With
End Sub
Private Sub indsætTotalFormler(ræk)
Dim kol As Byte, kolonneBogstav As String
    With arkTot
        For kol = 2 To 25
            kolonneBogstav = Chr(kol - 1 + 65)
            .Cells(ræk, kol).Formula = "=Sum(" & kolonneBogstav & "2:" & kolonneBogstav & CStr(ræk - 1) & ")"
        Next kol
       
        .Cells(ræk, kol).Formula = "=Sum(B" & CStr(ræk) & ":Y" & CStr(ræk) & ")"
       
        .Columns.AutoFit
    End With
End Sub