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
