Opdeling af txt-fil

1)
Ser at summen av Total A + Total B = Tallet bak total på øverste linje.
Ser ut til at det samme gjelder for Subtotal.
Er det altid slik?
Da holder det å skille ut A og B verdien for henholdsvis Total og Subtotal.
De kan eventuelt summeres senere

2)
Skal også Gnms. B volume benyttes,
Er det evt. flere mengder eller volumer som benyttes enkelte ganger?

3)
Hva med dato og klokkeslett?
og Recept Nr.

4)
Start og End forekommr i teksten.
Er det noe som kan oversees, eller skal det benyttes til noe

mvh
oyejo

Når jeg ser nærmere på dataene, kan det se ut som om det lønner seg å lese nedenfra?
Er det slik at Start betyr ny respept?
Og at Recept Nr og Dato klokkeslett kan brukes som overskrift på hver måleserie?

Hvis det også er slik at
Total A og B =
Forrige Total A og B pluss Subtotal A og B  på målingen?
Da kan man kansje nøyes med å lese subtotalene?

Håper spørsmålene ikke er for uklare :-)

Nej, nej det er snarere fordi filen er bygget ulogisk op.

Der skal læses fra toppen af, men START og END står bare forkert efter min overbevisning. De burde havde stået før og ikke efter teksten.

Men følgende felter skal bruges, og det er heldigvis kun START, END og ALARM-områderne som skal bruges (jeg finder lige en alarm). Ved START skal Totalværdi, Total A og B, Recept Nr og Bvolværdi bruges. Ved END er det Totalværdi, Total A og B samt tidspunktet. Ved ALARM skal det hele bruges.

En ALARM ser sådanne ud:

Ojeblikkel. Bvol 22.69
ALARM 10.42:31 19-03-04

En baggrundsforklaring som måske kunen være nyttig. Filen er en autogenereret txt-fil, som viser forbruget i en malerkabine. De forskellige recepter, er forskellige blandinger. Total er mængden af den aktuelle blanding, som på dette tidspunkt er brugt. Det vil sige, at den løbende tæller op. Total A og B er mængderne af de forskellige blandingsmaterialer, forholdet skulle gerne svare til Bvol. ALARM er når der er sket et eller andet uventet.

Dette er uoverskueligt for den person som skal aflæse filen, så han kunne godt tænke sig, minimum, at vi kunne stille det op på en overskuelig måde, og måske også med nogle diagrammer.

I forrige spørsmål laget vi en prosedyre OpneTextFilen()
Hva skjer hvis du erstatter den med denne?

Public Sub OpneTextFilen()
    Workbooks.OpenText Filename:=sFolder & sTxtFile, Origin:=xlWindows, _
      DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _
      Comma:=True, Space:=True, Other:=False
      End Sub

spørsmålet jeg henviste til:
http://www.eksperten.dk/spm/626157

Det ser ud til at det faktisk virker efter planen. Den fordeler næsten alt på forskellige kolonner, dog ikke hvor der står følgende "B:", "volume:" og diverse dato og tider.

Det er er jo sådan set udemærket, ihvert fald at den holder samme på tid og dato.

Jeg sender lige resultatet hjem. Der har jeg mulighed for at lægge det op på nettet, så kan du bedre se hvad der sker.

Det har du sgu gjort godt, men desværre tror jeg vi nu kommer til det rigtigt svære. At finde data, som skal bruges til diagrammer, for opbygningen er jo ikke ens fra gang til gang. Jeg mener her ikke hvordan det er sat op, men i hvilken række følge de forskellige handlinger sker. Min forsøgsfil starter f.eks. med en alarm, det skal vi nok ikke regne med, at den er der hver gang.

kan du lagre denne teksten som tekstfilen du benytter,
så kan vi gjøre en test:
La det være en blank linje før føste rad

Total    : 32336.49
Total A,B: 25869.48; 6467.01
SubTotal    : 0
SubTotal A,B: 0; 0
10.38:37  19-03-04
Recept Nr. 2  Bvol %  25
START


Ojeblikkel. Bvol 22.69
ALARM 10.42:31 19-03-04


Total    : 32343.09
Total A,B: 25874.76; 6468.33
SubTotal    : 6.73
SubTotal A,B: 5.38; 1.34
Gnms. B volume: 25.04
10.42:37  19-03-04
END


Total    : 32343.09
Total A,B: 25874.76; 6468.33
SubTotal    : 0
SubTotal A,B: 0; 0
10.42:38  19-03-04
Recept Nr. 2  Bvol %  25
START


Ojeblikkel. Bvol 23.53
ALARM 10.52:58 19-03-04


Total    : 32348.26
Total A,B: 25878.89; 6469.37
SubTotal    : 5.26
SubTotal A,B: 4.2; 1.05
Gnms. B volume: 25.07
10.53:40  19-03-04
END


Total    : 32348.26
Total A,B: 25878.89; 6469.37
SubTotal    : 0
SubTotal A,B: 0; 0
10.53:41  19-03-04
Recept Nr. 2  Bvol %  25
START


Ojeblikkel. Bvol 23.09
ALARM 11.04:46 19-03-04


Total    : 32371.1
Total A,B: 25897.17; 6473.94
SubTotal    : 23.16
SubTotal A,B: 18.51; 4.65
Gnms. B volume: 25.11
11.05:03  19-03-04
END

Declarasjonsmodulen skal se slik ut:

Option Explicit
Option Base 1

Public sFolder As String
Public sTxtFile As String
Public c As Variant

Public lFørsteRad As Long
Public vEtikett() As Variant
Public vRowColumnOffset() As Variant
Public vdB() As Variant

Slik skal prosedyremodulen se ut:

Option Explicit
Option Base 1

Public Sub OpneTextFilen()
    Workbooks.OpenText Filename:=sFolder & sTxtFile, Origin:=xlWindows, _
      DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _
      Comma:=True, Space:=True, Other:=False
      'TIPS Other:=True, OtherChar:=":"
End Sub

Public Sub HeleReceptTilEnCelle()
  Columns("A:A").Select
  For Each c In Selection
    If c.Value = "Recept" Then
    c.Value = c.Value & " " & c.Offset(0, 1).Value & " " _
    & c.Offset(0, 2).Value & " " & c.Offset(0, 3).Value _
    & c.Offset(0, 4).Value & " " & c.Offset(0, 5).Value _
    & c.Offset(0, 6).Value
    End If
  Next
End Sub

Public Sub DataFraTekstFilTilMatrise()
  Dim i As Long
  Dim n As Long
 
  For n = 1 To 3
    vdB(n, 1) = n
    For i = 1 To 15
      vdB(n, i + 1) = Range( _
      Cells(lFørsteRad, 1), Cells(lFørsteRad, 1)).Offset( _
        vRowColumnOffset(1)(i) - 1, vRowColumnOffset(2)(i) - 1)
    Next
    lFørsteRad = lFørsteRad + 22
  Next
End Sub

Public Sub DataTilRegneark()
  Dim i As Long
  Dim n As Long
 
  Workbooks.Add
  For i = 1 To 15
  Range(Cells(1, i), Cells(1, i)) = vEtikett(i)
  Next
 
  For n = 1 To 3
  For i = 1 To 15
    Range(Cells(1 + n, i), Cells(n + 1, i)) = vdB(n, i)
  Next
  Next
End Sub

Her kommer Hovedmodulen, når er jeg spent på hva som skjer :-)

Option Explicit
Option Base 1

Public Sub HovedRutine()
  sFolder = "c:/temp/"
  sTxtFile = "maling2.txt"
  ReDim vdB(3, 16)
  lFørsteRad = 2
  vEtikett = Array("Batch nr", "oTotA", "oTotB", "oDato", "oKlokke", "Resept", _
                "aDato", "aKlokke", "OjeblikkBvol", _
                "nTotA", "nTotB", "SubA", "SubB", "GnmsBvol", _
                "EndDato", "EndKlokke")

  vRowColumnOffset = Array( _
        Array(2, 2, 5, 5, 6, 11, 11, 10, 15, 15, 17, 17, 18, 19, 19), _
        Array(4, 5, 2, 1, 1, 3, 2, 3, 4, 5, 4, 5, 4, 2, 1))
 
  Call OpneTextFilen
  Call HeleReceptTilEnCelle
  Call DataFraTekstFilTilMatrise
  Call DataTilRegneark
End Sub

Det er viktig at vi har samme tekstfil når vi tester ut.
Det må være en blank linje først. ( og kun en )
Så må første linje med total komme

Da er det bare å trykke på knappen.
Etter at du har kjørt programmet kan du merke hele arket og velge:
Formater -> kolonne -> Beste tilpassning

En rettelse i den ene prosedyren:
tallet 15 er rettet til 16
NB!  Dette gjelder kun DataTilRegneark() prosedyren:

Public Sub DataTilRegneark()
  Dim i As Long
  Dim n As Long
 
  Workbooks.Add
  For i = 1 To 16
  Range(Cells(1, i), Cells(1, i)) = vEtikett(i)
  Next
 
  For n = 1 To 3
  For i = 1 To 16
    Range(Cells(1 + n, i), Cells(n + 1, i)) = vdB(n, i)
  Next
  Next
End Sub

Du skriver i din kommentar:
for opbygningen er jo ikke ens fra gang til gang
Dette trenger ikke være så vanskelig som det først ser ut til.
Det må gjøres noen enkle tester, men mest sannsylig er det bare noen få varianter.
1) Man må finne antall serier.
2) Man må finne første celle i hver serie
3) Man må vite hvilken type serie som kommer.
Det trenger ikke være noen umulig oppgave
Når dataene er på plass er det enkelt å generere diagrammene

Bare så du ikke venter forgæves. Jeg kan ikke komme til at lave noget der på igen, før mandag tidligst.

Undskylder med fik ikke tid til at lægge en fil op.

Resultatet af importeringen er lidt overraskende, men måske har du regnet med det. Den viser nemlig ingen af tallene, men kun betegnelserne, og en del af den sætte den til bogstav foran, f.eks. o.

Nu er det jo svært at vise rigtigt her på E!, men jeg prøver.

Batch nr    oTotA    oTotB    oDato    oKlokke    Resept    aDato    aKlokke    OjeblikkBvol    nTotA    nTotB    SubA    SubB    GnmsBvol    EndDato    EndKlokke
1            A    Total    SubTotal                                Bvol        START
2            A    Total    SubTotal                                Bvol        START
3            A    Total    SubTotal                                Bvol        START

nummerne står under Bacth,
A under oDato,
Total under oKlokke,
SubTotal under Recept,
Bvol under GnmsBvol,
START under EndKlokke

Har du kopiert teksten som jeg limte inn den 01/07-2005 14:12:28
for så å lagre den som maling2.txt ?

Nej det gjorde jeg ikke, jeg gjorde det på filen, som den ser ud når den er færdigskrevet. Men det gør ingen forskel. Jeg kan nå at se, at filen bliver indlæst med det hele også værdier, men idet det bliver ændret layoutmæssigt, så forsvinder tallende.

Du må bruke teksten jeg limte inn til å begynne med, bare for en test.
Da skal tallverdiene komme på riktig plass.
Husk, først en blank linje, så første linje med data

Okay, så kommer de rigtigt ind:

Batch nr    oTotA    oTotB    oDato    oKlokke    Resept    aDato    aKlokke    OjeblikkBvol    nTotA    nTotB    SubA    SubB    GnmsBvol    EndDato    EndKlokke
1    25869,48    6467,01    19-03-04    10.38:37    Recept Nr. 2 Bvol% 25    19-03-04    10.42:31    22,69    25874,76    6468,33    5,38    1,34    25,04    19-03-04    10.42:37
2    25874,76    6468,33    19-03-04    10.42:38    Recept Nr. 2 Bvol% 25    19-03-04    10.52:58    23,53    25878,89    6469,37    4,2    1,05    25,07    19-03-04    10.53:40
3    25878,89    6469,37    19-03-04    10.53:41    Recept Nr. 2 Bvol% 25    19-03-04    11.04:46    23,09    25897,17    6473,94    18,51    4,65    25,11    19-03-04    11.05:03

Jeg syntes du sagde du ikek var så hård til dette... ;-) Det ved jeg nu ikke

Da blir neste spørsmål?
I din tekstfil i forrige spørsmål, var det noen data der det stod Test og Foedemengde.
Har du bruk for disse data?

Kort og godt, nej

Da tror jeg det eneste problemer vi står ovenfor er:
å åpne din orginale tekstfil, slik at alle tallene som skal benyttes ligger i hver sin celle. ( hvert tall vi skal benytte må ha sin unike adresse)

Det er nok en forskjell på den tekstfila vi benyttet sist og de du skal bruke.
At antall rader er forskjellige har ingen betydning ( tror jeg )

Det beste er om du manuelt kan se om du får åpent filen, slik at alle tall som skal benyttes, ligger alene i hver sin celle.
Hvis du finner en måte å gjøre dette på, kan du spille inn en makro som vi kan benytte.

Den originale fil bliver ikke indlæst korrekt. Den ser sådan:

Batch nr    oTotA    oTotB    oDato    oKlokke    Resept    aDato    aKlokke    OjeblikkBvol    nTotA    nTotB    SubA    SubB    GnmsBvol    EndDato    EndKlokke
1            A    Total    SubTotal                                Bvol        START
2            A    Total    SubTotal                                Bvol        START
3            A    Total    SubTotal                                Bvol        START

Kan du sende over den orginale txt-filen til meg.
Det er viktig at du sender den akkurat slik den blir åpnet.
min mail:
oyejoh@hotmail.com

Hvis du legger en besked her når fila er sendt slipper jeg å logge på hotmail for å sjekke.

Så er det sendt

det ser ut til at forskejllen ligger i et ekstra linjeskift.
jeg må nok endre litt på koden

det ser ut til at den tekstfila du sendt med er åpnet med makroen.
Det fører til at den blir endret.
Så jeg må desverre mase på deg en gang til :-)
så hvis du kan sende filvedlegget med txt- endelsen så tror jeg vi kan ha det morro idag :-)
jeg trenger ikke xls-filene
mvh
oyejo

du skulle gerne have modtaget originalen også. Den hedder fredag.txt

jeg finner kun to filvedlegg det er to xls-filer

jeg finner tekste av fredad.txt,  men det tror jeg er teksten kopiert inn i mailen.
jeg trenger den som et filvedlegg på grunn av kodingen foreksempel hvis det er spesiel koding for linjeskift.

en annnen ting. for meg ser det ut som teksten i fredag.txt er åpnet med makroen og så koperiert eller lagret i mailen.

Det blir feil fordi noen av de orginale tengene forsvinner fordi de i makroen er bekrevet som skilletegn.

txt.fila må ikke være åpnet av en exelfil, kun i notepad for at jeg skal finne ut av det.

Fredag.txt ER den originale fil og den er ikke blevet åbnet og gemt i andet end notepad, og den er vedhæftet som txt-fil. Men jeg prøver lige noget andet, en zip-fil måske.

Heisann ja nå har jeg fått den riktige filen.
Ser at det er litt arbeide, men jeg skal se på den etter middagen.

Når jeg åpnet txt-fila som ble zippet, ble jeg positivt overrasket.
Her var det ingen blanke linjer. Det gjorde jobben mye lettere.
Nå håper jeg at alle txt-filene er like, ellers må det legges til litt mere kode.
Det hele fungerer nå på min pc.

Det beste er om du fjerner all gammel kode fra dine moduler.
BARE DISSE TO ØVERSTE LINJENE SKAL STÅ TILBAKE:

Option Explicit
Option Base 1

Denne koden skal inn i declarasjonsmodulen ( i tilleg til de 2 øverste linjer ):

Public Const cRaderMellomHverSerie = 18

Public n As Long, i As Long, s As Long
Public c As Variant

Public sFolder As String
Public sTxtFile As String

Public lStartRadPost As Long
Public lPostCounter As Long
Public vRowColumnOffset() As Variant

Public vEtikett() As Variant
Public vdB() As Variant

Her kommer kode til Hovedmodul:

Public Sub HovedRutine()
  sFolder = "c:/temp/"
  sTxtFile = "maling2.txt"
  lStartRadPost = 1
 
  vEtikett = Array("n", "iTot", "iTotA", "iTotB", "Resept", "Bvol%", _
                "aDato", "aKlokke", "aBvol", _
                "nTot", "nTotA", "nTotB", _
                "SubT", "SubA", "SubB", "nBvol", _
                "EndDato", "EndKlokke")

  vRowColumnOffset = Array( _
        Array(15, 0, 1, 1, 5, 5, _
              8, 8, 7, _
              9, 10, 10, _
              11, 12, 12, 13, _
              14, 14), _
        Array(1, 2, 3, 4, 1, 5, _
              2, 1, 2, _
              2, 3, 4, _
              2, 3, 4, 3, _
              1, 0))
 
  Call OpneTextFilen
  Call OrdneTxtFil
  Call DataFraTekstFilTilMatrise
  Call DataTilRegneark

End Sub

Alle de andre prosedyrene skal ligge i Prosedyremodulen:
Du får hver Public Sub ( prosedyre ) for seg, det er bare
å lime dem inn etter hverandre:

Public Sub OpneTextFilen()
    Workbooks.OpenText Filename:=sFolder & sTxtFile, Origin:=xlWindows, _
      DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _
      Comma:=True, Space:=True, Other:=False
End Sub

Public Sub OrdneTxtFil()
 
  For s = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(s, 1).Value = "Bvol" Then
      Rows(s - 4 & ":" & s + 1).Delete shift:=xlUp
    End If
  Next
 
  Rows("1:15").Insert shift:=xlDown
 
  For s = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(s, 1).Value = "START" Or Cells(s, 1).Value = "END" Then
      Rows(s + 1 & ":" & s + 2).Insert shift:=xlDown
    End If
  Next
 
  For s = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(s, 1).Value = "ALARM" Then
      Cells(s, 1).Value = "ALARM!"
      Rows(s - 3 & ":" & s - 2).Delete shift:=xlUp
    End If
  Next
 
  If Not Cells(Range("A" & Rows.Count).End(xlUp).Row, 1).Value = "END" Then
    Cells(Range("A" & Rows.Count).End(xlUp).Row, 1).Offset(9, 0).Value = "END"
  End If
 
  s = 1
  Do Until Cells(s, 1).Value = "END"
  s = s + 1
  Loop
  Rows(1 & ":" & s - 16).Delete shift:=xlUp
 
  Columns("A:A").Select
  lPostCounter = 0
  For Each c In Selection
    If c.Value = "Recept" Then
    c.Offset(0, 1).Value = c.Offset(0, 1).Value & c.Offset(0, 2).Value
    End If
    If c.Value = "END" Then
      lPostCounter = lPostCounter + 1
    c.Offset(0, 1).Value = lPostCounter
    End If
  Next
 
End Sub

Public Sub DataFraTekstFilTilMatrise()
 
  ReDim vdB(lPostCounter, UBound(vRowColumnOffset(1), 1))
 
  For n = 1 To lPostCounter
    For i = 1 To UBound(vRowColumnOffset(1), 1)
      vdB(n, i) = Cells(lStartRadPost, 1).Offset( _
        vRowColumnOffset(1)(i), vRowColumnOffset(2)(i))
    Next
    lStartRadPost = lStartRadPost + cRaderMellomHverSerie
  Next

End Sub

Public Sub DataTilRegneark()

  Workbooks.Add
  For i = 1 To UBound(vEtikett())
  Cells(1, i) = vEtikett(i)
  Next
  For n = 1 To lPostCounter
    For i = 1 To UBound(vRowColumnOffset(1), 1)
      Cells(n + 1, i) = vdB(n, i)
    Next
  Next
  Cells.HorizontalAlignment = xlCenter
  Cells.Columns.AutoFit
 
  Range("H2:H" & lPostCounter + 1).Replace What:=".", Replacement:=":"
  Range("R2:R" & lPostCounter + 1).Replace What:=".", Replacement:=":"
End Sub

Håper det også funger hos deg. Hvis det fugerer er det nå lett for
deg å endre kolonneoverskrifer, du kan lett velge å ta bort noen
kolonner med data og eventuelt legge til andre kolonner med data.

Alt dette gøres i Hovedmodulen.

Jeg håber også opbygningsmæssigt, at original filerne er korrekte, men ved det faktisk ikke.

Damn, det ser totalt rodet ud, nå jeg gemmen går lige for at se om det importerede er som det skal være, men jeg tror det desværre ikke. :-(

Prøv å legg inn denne koden øverst i  Public Sub OrdneTxtFil()
 
  For s = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(s, 1).Value = "" Then
      Rows(s & ":" & s).Delete shift:=xlUp
    End If
  Next


Ikke ta bort noe, bare legg til den nye
PS! Dette får vi til :-)

Okay, selve importeringen ser rigtigt ud, men det går helt galt når du begynder at vende data om. Jeg kan faktisk ikke lige se hverken hoved eller hale i det lige nu

Jeg sender lige de 2 filer til dig, så du for dig selv kan se resultatet. Jeg håber navngivningen siger sig selv, jeg har tilladt at gemme begge som Excel projektmapper.

Hvis det ennu ikke virker kan du sjekke dette:

I teksfilen som ble åpnet og ordnet skal det stå END i en del celler i kollonne A.

END SKAL STÅ I FØLGENDE RADER:
16, 34, 52, 70, 88, ...og så videre
du skal legge til 18 for å få neste rad.

Benytter du office 2000 ?
Hvis du gjør det skal jeg teste på en annen maskin.

Ja, på denne maskine, er det 2000. Desværre ved jeg ikke lige hvilke version der bliver brugt der hvor den reelt skal bruges.

i Hovedrutinen kan du markere de 3 nederste call setningen med en ' forran
de blir da tolket som tekst og ikke utført.
Da kan vi se på tekstfilen før den blir "rotet til"
Slik skal det da se ut

Call OpneTextFilen
' Call OrdneTxtFil
' Call DataFraTekstFilTilMatrise
' Call DataTilRegneark

og END passer ikke, den stiger med 24 hver gang

Jeg har nu ændret 18 til 24, og det hjalp noget med ikke på alt

Et annet triks:
sjekk kolonne A nedover i filen som ble åpnet.
Hvis du finner verdien 0 i noen celler i kolonne A,
har vi funnet feilen

Hvis den stiger med 24, kan også det fikses,
men da må du sjekke kolonnen helt ned slik at vi er sikre på at det er 24
mellom hver helt til bunns

Problemet er at du har en del ekstra linjeskift i din fil

Der står ikke 0 i kolonne A, dog er der til sidst en END, som ikke skal være der. END 13 er ikke i originalfilen.

Den siste End blir satt inn av koden for kontroll.
Jeg ser på de filene du sendet meg,
Jeg sender over en ny modul til deg slik at vi er sikre på at din kode er riktig.

Public Sub OrdneTxtFil()
 
  For s = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(s, 1).Value = "" Then
      Rows(s & ":" & s).Delete shift:=xlUp
    End If
  Next
 
  For s = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(s, 1).Value = "Bvol" Then
      Rows(s - 4 & ":" & s + 1).Delete shift:=xlUp
    End If
  Next
 
  Rows("1:15").Insert shift:=xlDown
 
  For s = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(s, 1).Value = "START" Or Cells(s, 1).Value = "END" Then
      Rows(s + 1 & ":" & s + 2).Insert shift:=xlDown
    End If
  Next
 
  For s = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(s, 1).Value = "ALARM" Then
      Cells(s, 1).Value = "ALARM!"
      Rows(s - 3 & ":" & s - 2).Delete shift:=xlUp
    End If
  Next
 
  If Not Cells(Range("A" & Rows.Count).End(xlUp).Row, 1).Value = "END" Then
    Cells(Range("A" & Rows.Count).End(xlUp).Row, 1).Offset(9, 0).Value = "END"
  End If
 
  s = 1
  Do Until Cells(s, 1).Value = "END"
  s = s + 1
  Loop
  Rows(1 & ":" & s - 16).Delete shift:=xlUp
 
  Columns("A:A").Select
  lPostCounter = 0
  For Each c In Selection
    If c.Value = "Recept" Then
    c.Offset(0, 1).Value = c.Offset(0, 1).Value & c.Offset(0, 2).Value
    End If
    If c.Value = "END" Then
      lPostCounter = lPostCounter + 1
    c.Offset(0, 1).Value = lPostCounter
    End If
  Next
 
End Sub

ta bort den gamle modulen med samme navn, prøv så denne.

har tatt en titt på god før kovnverteringfila du sendte.
den eneste feilen er at det er for mange blanke rader.
tror den nye koden du fikk, skal fikse det.

Nej, den nye koden fikser det ikke. Jeg kan se at originalfilen indeholder en fejl. På et tidspunkt står der þÿÿÿTotal i stedet for bare Total, er det noget der har betydning for din kode, jeg kan se at det kommer med ind, men derfor kan det jo godt ske, at det laver rav i det

Hov hov, det slog mig, jeg havde jo ændret antal linier fra 18 til 24. Så det ændrede jeg tiblage, og det hjalp vidst meget, så stop bare lige midlertidig, til jeg får den gennemtjekket om det er i orden.

þÿÿÿTotal  skal ikke skape problemer.

I hovedrutinen
bruk bare disse Call for testing

Call OpneTextFilen
Call test


Legg så denne inn i prosedyremodulen:

Public Sub test()
  For s = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(s, 1).Value = "" Then
      Rows(s & ":" & s).Delete shift:=xlUp
    End If
  Next

Men jeg tror godt lige jeg vil have en forklaring omkring din opbygning. Så vidt jeg kan se kommer ALARM'erne først, men er det rigtigt?

Og hvad betyder iTot, iTotA, iTotB, og de sammen med med n foran.

resultate skal være at tekstfilen blir åpnet.
så skal alle tomme rader slettes

det er bare navn som jeg har satt til overskrifter
Og hvad betyder iTot, iTotA, iTotB, og de sammen med med n foran.
iTot er den totale som står i Start modulen
nTot er den totalen som står i End modulen
alle med a foran er Alarmdata, dette kan vi lett endre når vi har fått fjernet de blanke rader.

Det er det eneste problemet vi har ( tror jeg )

Yeps, nu har jeg ikke testet med testen.... hmm ;-P

Men jeg tror også at det eneste problem nu er opsætningen, bl.a. bliver ALARM og START/END blandet lidt sammen. For overblikkets skyld kunne jeg bl.a. godt tænke mig, at de blev adskidt, men måske er der andre ting også.

ser at jeg glemet End sub på slutten av Public sub test:

Public Sub test()
  For s = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(s, 1).Value = "" Then
      Rows(s & ":" & s).Delete shift:=xlUp
    End If
  Next

uf da End sub ble ikke med denne gang heller.

Public Sub test()
  For s = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(s, 1).Value = "" Then
      Rows(s & ":" & s).Delete shift:=xlUp
    End If
  Next
End Sub

Jeg la test inn i excelfila du sendte meg, den fjernet alle blanke rader,
Tror det bare er en liten bagatell før det hele fungerer

Denne test er det for at fjerne þÿÿÿTotal?

For så bare drop det, det gider vi sgu ikke kigge på. Det ser ikke ud til at have nogen effekt.

Tilgengæld, så vil jeg mene, at importeringen er færdig. Dog overvejer jeg lidt om vi skal have dato og tidspunkt ind for start også, men det skal jeg lige hører personen som skal bruge det om.

Det næste bliver så at prøve at lave et diagram automatisk, er du med på den også?

du skriver:
Men jeg tror også at det eneste problem nu er opsætningen, bl.a. bliver ALARM og START/END blandet lidt sammen. For overblikkets skyld kunne jeg bl.a. godt tænke mig, at de blev adskidt, men måske er der andre ting også.

når vi er i stand til å fjerne alle blanke rader,
kan vi med letthet endre oppsette slik du ønsker.

Måle må være at jeg kan vise deg, slik at du selv kan endre det slik du vil

du skriver : Denne test er det for at fjerne þÿÿÿTotal?
nei test er helt avgjørende for at vi skal komme videre.

Kan du ikke sende over excel arket med kanppen og koden
Så skal jeg se over og sende den tilbake

Yes, jeg skulle gerne selv kunne rette i det.

De der tomme felter du snakker om, er det på importeringen før konverteringen? For ellers er der ingen tomme linie som ikke burde være der. Efter du har vendt data om, er der jo kun tomme felter, hvor der ikke er noget data, f.eks. ingen ALARM, ingen START eller ingen END, og det vil jo ske ind i mellem.

diagrammet skal vi fikse :-)

ja det er før konverteringe at vi skal fjerne alle tomme rader.

Jeg fikk to regneark med data, men jeg trenger
Regnareket der du har lavet knappen og vba-koden

Ja, jeg får også en masse projektmapper. Den med knappen, den lige efter import og den efter konvertering. De 2 sidste, kan de ikke komme i samme projektmappe, men på hver sit regneark?

De tomme felter er bare luksus, de er pt. ikke nødvendige at fjerne, jeg tvivler på de vil bruge den til noget

jeg sender deg et et regneark med makroknapp, det heter import3.xls

og import3.xls er...?

Jeg sidder og prøver på den normale måde at lave et diagram, over dataen. Men det kniber sgu lidt. Jeg mener man burde kunne lave et kurvediagram ud fra en datakilde, på denne skulle man kunne sætte punkter ind ud fra en anden datakilde. Men det var måske kun i XP og 2003 man kan det.

Min ide til diagrammet var at den viset forbruget pr. recept over tid, og alarmerne skal så sættes ind som punkter på kurve, selvfølgelig ud fra deres rigtige tid, men det sidste drilelr mig lidt

Nå, sorry, der gik lige lidt sprogforvirring i det der. Jeg troede filen hentede import3.xls og at den hedder det.

Men jeg kan ikke rigtigt se nogen forskel.

ser du har kommet med en del spørsmål jeg ikke har rukket å svare på.
jeg lover å komme tilbake til disse.

Men vi må løse problemet med de tomme radene først,
vi kommer ikke lengre før vi har løst det problemet.

jeg kommer til å sende deg en ny fil med knapp og makro.
så vil jeg at du skal sende meg tekstfilen fredag.txt som excelfil.

Har en mistanke om at cellene som ser tomme ut, ikke er det likevel
det vil ta litt tid

okay, jeg tror de fleste spørgsmål er blevet besvaret, ellers kan jeg bare stille dem igen, men hvorfor er de tomme række så stort et problem?

jeg vil gjerne at du sender meg den fredag.xls som ble åpnet av imoprt3.xls


Senere skal jeg forklare hele prinsippet som programmet bygger på.
slik at du senere kan endre det slik du ønsker.

prinsippe er slik:
først har vi en variabel som heter :  lStartRadPost.
Det starter med at : lStartRadPost = 1
Celle  ( lStartRadPost ,  1 ) er celle A1 rad en kolonne 1

For å finne de riktige data benyttes :

vRowColumnOffset = Array( _
        Array(15, 0, 1, 1, 5, 5, _    'viser antall rader fra
              8, 8, 7, _              Celle (lStartRadPost, A )
              9, 10, 10, _
              11, 12, 12, 13, _
              14, 14), _
        Array(1, 2, 3, 4, 1, 5, _  viser antall kolonner
              2, 1, 2, _            fra Celle (lStartRadPost, A )
              2, 3, 4, _
              2, 3, 4, 3, _
              1, 0))

slik blir de riktige data hentet.
når data fra en rad er ferdig, får vi : 
lStartRadPost = lStartRadPost + 18
vi flytter 18 rader ned og forholdet mellom denne celle (19 , A )
og de data er det samme som forrige gang.

I prosedyren FraTekstfil til Matrise leses data fra tekstfilen til minnet i pc'en
Etterpå kan gjerne txt-fila lukkes, det er ikke bruk for den.

så i prosedyren DataTilRegneark, leses data fra maskines minne og til excel.

fredag.xls åbnet via import3.xls er sendt

Dette krever at filens oppbygning er den samme hele veien.
Derfor fjernes først alle tomme rader.
Så i neste omgang blir det fylt på med tomme rader slik at forholdet
mellom startcelle og data blir riktig.

Så derfor, en ekstra tom rad vil ødelegge hele systemet :-)

Jaaaaaaaaaaaaaaaaaaaaaaaaaaaa!!!!!!!!!!!!!!!!!
fredag.xls åbnet via import3.xls ER JO SLIK DEN SKAL VÆRE!!!
DA KAN VI GÅ VIDERE  :-)

Da kan vi få bok.xls eller hva den nå heter til å bli slik vi ønkser

nå må nesten du stille spørsmål- slik at jeg vet hva jeg skal svare på

Jubiii, det lød som en sejr, af de bedre?

Første spørgsmål/ønske: Jeg vil gerne have data åbnet i samme projektmappe med i hver sit regneark. Sådan at man ikke få flere filer åbnet end makroen og resultatet. F.eks. kune ark1 være importeringen af fredag og ark2 kunne være efter konverteringen.

En av de bedre sejrer, og så bare på grunn av ingen ting :-) tomme rader

jeg er litt usiker på hva du mener med prosjektmappe.
Er det en excel-bok med flere ark?
Det er ikke noe problem å organisere alle data i en excelbok med flere ark.

Men ett prinsipp bør du ikke fravike:
excel-boken med knap og makrokode, bør ikke innehodle data.
du kan lagre den hvor som helst, men ingen data i denne makro excel bok.

jeg skal lage litt kode men i det er ikke sikkert jeg rekker det før på mandag.

så i mellomtiden bør du tenke på hvilke data du trenger,
gjerne teste litt selv.

overskriftene lages i vEtikett(), prøv deg fram , du gjør ingen skade.
Hvis du for eksempel ikke vil ha telleren i kolonne A kan du bare ta bort "n" i vEtikett.
Da må du samtidig ta bort tallet 15 første elemetet i vRadkollonneOffset
den viser at tallet ligger 15 rader under startraden.
så må du også fjerne det tilvsarende talle i Arrayet nedenfor som viser at det ligger en kolonne til høyre for kollonne A

Lykke til :-)

Når du starter Excel på er der faktisk en projektmappe du åbner. Denne projektmappe kan så indeholder flere Regneark, deraf navner Ark1, Ark2, Ark3 osv. osv. Lyder til at I kalder dem for Excelbok...?

Og nej jeg vil heller ikke have data i projektmappen med makroen. Det der kommer ud af makroen må dog godt blive samlet.

Jeg har kigget lidt på både kode og diagrammer, men med det sidste, skal jeg lige hører brugeren hvad han gerne vil have. Det er jo ikke sikkert det er det samme som hvad jeg har tænkt mig ;-)

Så det lyder fint med at fortsætter vores kamp på mandag.

heisann  lsskaarup ja da ønsker jeg deg god helg,
så kan vi kjempe videre fra mandag ca kl 16
vi kommer til å nå over 100 meldinger ;-)
kanskje vi kan gi dem ut som bok,  "vores kamp" :-)

Jeps, det må da være et af de største/længeste spørgsmål ;-)

Jeg var faktisk ud for at snakke med brugeren om den konverterede oversigt, men han var ikke tilstede og kommer ikke før mandag, så der kan jeg først finde ud af om han vil have noget ændret.

Da har jeg puslet litt med vår lille program, tiden går fort når driver med dette
Det har blitt endringer i declarasjonene, så jeg sender hele modulen
De andre prosedyrene skal i prosedyremodulen:
DataTilRegneark er endret, limer inn hele prosedyren, så kan du erstatte den gamel
Så kommer en helt ny modul som laver diagrammet, du må lage et kall i hovedmodulen, det skal stå sist.
Jeg vet jo ikke hvordan du egentlig vil ha det, men jeg tror du nå har fått så mangen eksempeler at du kan klare deg på egen hånd. ( et lite tips kan du jo selvsagt få :-)
Det har vært en interesant oppagav, har faktisk løst noen problemer jeg hadde på en lignende oppgave som jeg benytter selv.

'Declarasjoner

Option Explicit
Option Base 1

Public Const cRaderMellomHverSerie = 18

Public n As Long, i As Long, s As Long
Public r As Long, k As Long
Public c As Variant
Public dDato(2) As Date

Public sFolder As String
Public sTxtFile As String

Public lStartRadPost As Long
Public lPostCounter As Long
Public vRowColumnOffset() As Variant

Public vEtikett() As Variant
Public vdB() As Variant

Public Sub DataTilRegneark()

  Worksheets.Add
  Sheets(1).Name = "KonvData"
  Sheets(2).Name = "TxtData"
 
  For i = 1 To UBound(vEtikett())
  Cells(1, i) = vEtikett(i)
  Next
  For n = 1 To lPostCounter
    For i = 1 To UBound(vRowColumnOffset(1), 1)
      Cells(n + 1, i) = vdB(n, i)
    Next
  Next
  Cells.HorizontalAlignment = xlCenter
  Cells.Columns.AutoFit
 
  Range("H2:H" & lPostCounter + 1).Replace What:=".", Replacement:=":"
  Range("R2:R" & lPostCounter + 1).Replace What:=".", Replacement:=":"
  Range("G2:R" & lPostCounter + 1).Replace What:="-", Replacement:="."
  Range("Q2:R" & lPostCounter + 1).Replace What:="-", Replacement:="."
  Columns("H:H").NumberFormat = "hh:mm;@"
  Columns("R:R").NumberFormat = "hh:mm;@"
 
  dDato(1) = Cells(2, 17).Value
 
  Range("G2:G" & lPostCounter + 1).Select
  For Each c In Selection
    If c.Value = "" Then
      c.Value = ""
    Else
    dDato(2) = c.Value
    c.Value = Format(dDato(2), "dd.mmm.")
    End If
  Next
 
  dDato(2) = 0
 
  Range("Q2:Q" & lPostCounter + 1).Select
  For Each c In Selection
    If c.Value = "" Or Format(c.Value, "dd.mmm.") = Format(dDato(2), "dd.mmm.") Then
      c.Value = ""
    Else
    dDato(2) = c.Value
    c.Value = Format(dDato(2), "dd.mmm.")
    End If
  Next
 
 
End Sub

Public Sub LagDiagram()

  r = Range("R" & Rows.Count).End(xlUp).Row
 
  With Charts.Add
    .Location Where:=xlLocationAsNewSheet
    .HasTitle = True
    .ChartType = xlColumnStacked
    .Move After:=Sheets(1)
    .Name = "Diagram"
    With .ChartTitle
      .AutoScaleFont = True
      With .Font
        .FontStyle = "Halvfet"
        .Size = 12
      End With
    End With
   
   
    Set c = .TextBoxes.Add(220#, 18#, 200#, 10#)
    With c
      .Text = Format(dDato(1), "dd. mmmm yyyy")
      '.Formula = "=Ark1!Q2"
      .HorizontalAlignment = xlCenter
      With .Font
        .Name = "Arial": .Size = 12: .Bold = False
      End With
    End With
   
     
    With .Legend
      .Position = xlBottom: .Font.Size = 10
      .Left = 330
    End With
       
    With .SeriesCollection(1)
      .Name = "=KonvData!R1C14"
      .Values = "=KonvData!R2C13:R" & r & "C13"
      .XValues = "=(KonvData!R2C17:R" & r & "C18)"
    End With
   
    .SeriesCollection.NewSeries
    With .SeriesCollection(2)
      .Name = "=KonvData!R1C15"
      .Values = "=KonvData!R2C15:R" & r & "C15"
      .XValues = "=(KonvData!R2C17:R" & r & "C18)"
    End With
   
    .SeriesCollection.NewSeries
    With .SeriesCollection(3)
      .Name = "=KonvData!R1C16"
      .Values = "=KonvData!R2C16:R" & r & "C16"
      .XValues = "=(KonvData!R2C5:R" & r & "C5)"
      .ChartType = xlLineMarkers
      .AxisGroup = 2
      .ApplyDataLabels AutoText:=True, ShowValue:=True
      With .DataLabels
        .AutoScaleFont = True
        .Font.Size = 8
        .NumberFormat = "0.00""%"""
        .Position = xlLabelPositionRight
        .Orientation = xlUpward
      End With
    End With
   
   
    With .Axes(xlCategory, xlPrimary)
      .HasTitle = True
      With .AxisTitle
        .Characters.Text = "Tid og Dato"
        .Top = 400
        .Left = 320
      End With
    End With
   
    .HasAxis(xlCategory, xlSecondary) = True
    With .Axes(xlCategory, xlSecondary)
      .HasTitle = True
      With .AxisTitle
        .Characters.Text = "Recept"
        .Top = 11
        .Left = 336
        With .Font
          .FontStyle = "Normal"
          .Size = 12
        End With
      End With
    End With
   
    With .Axes(xlValue, xlPrimary)
      .HasTitle = True
      .AxisTitle.Characters.Text = "Volum"
      With .TickLabels
        .NumberFormat = "0"" liter""": .Font.Size = 8
      End With
    End With
   
    With .Axes(xlValue, xlSecondary)
      .HasTitle = True
      .AxisTitle.Characters.Text = "Bvol%"
      With .TickLabels
        .NumberFormat = "0"" %""": .Font.Size = 8
      End With
    End With
    .ChartArea.Select
  End With
End Sub

Noe av koden kunne vært gjort litt mere effektiv med flere for løkker og variabler
Men da hedde den vært vanskeligere å lese for utenforstående.

Den kan evetuelt gjøres litt mere elegant senere

Okay, jeg har ikke lige kopieret din nye kode ind.

Jeg fik i går aftens snakket med ham som skal bruge det. Han er tilfreds, men mangler lige dato og tidspunkt for START også, ellers ser det godt ud.

Så er det bare diagrammet, puha, nu ved jeg ikke om din kode allerede laver det, men det finder jeg jo nok ud af... ;-P

Men jeg har lidt problemer med bare at få lavet et diagram, som kan bruges. Har bare forsøgt på den tradionelle måde. Jeg kunne godt tænke mig, et diagram, som ud ad x-aksen har et tidsinterval, op ad y-aksen mængden, og måske et kurvediagram for hver recept, til sidst skal alarmerne markeres på kurven. Det var især et sidste som var det helt store problem.

Her kommer en liten endring av LagDiagram-prosedyren
Husk at under de andre call setnigene i Hovedrutinen, skal det stå :
Call LagDiagram

Denne prosedyren skal ligge i prosedyremodulen

Public Sub LagDiagram()

  r = Range("R" & Rows.Count).End(xlUp).Row
  With Charts.Add
    .Location Where:=xlLocationAsNewSheet
    .HasTitle = True
    .ChartTitle.Characters.Text = _
    "Finn meg i koden i LagDiagram(), der kan du endre meg :-)"
         
    .ChartType = xlColumnStacked
    .Name = "Diagram"
    With .ChartTitle
      .AutoScaleFont = True
      With .Font
        .FontStyle = "Halvfet"
        .Size = 12
      End With
    End With
   
    Set c = .TextBoxes.Add(230#, 21#, 200#, 10#)
    With c
      .Text = Format(dDato(1), "dd. mmmm yyyy")
      .HorizontalAlignment = xlCenter
      With .Font
        .Name = "Arial": .Size = 12: .Bold = False
      End With
    End With
     
    With .Legend
      .Position = xlBottom: .Font.Size = 10
      .Left = 330
    End With
       
    With .SeriesCollection(1)
      .Name = "=KonvData!R1C14"
      .Values = "=KonvData!R2C14:R" & r & "C14"
      .XValues = "=(KonvData!R2C17:R" & r & "C18)"
    End With
   
    .SeriesCollection.NewSeries
    With .SeriesCollection(2)
      .Name = "=KonvData!R1C15"
      .Values = "=KonvData!R2C15:R" & r & "C15"
      .XValues = "=(KonvData!R2C17:R" & r & "C18)"
    End With
   
    .SeriesCollection.NewSeries
    With .SeriesCollection(3)
      .Name = "SubTot  "
      .Values = "=KonvData!R2C13:R" & r & "C13"
      .XValues = "=(KonvData!R2C17:R" & r & "C18)"
      .ChartType = xlLineMarkers
      .ApplyDataLabels AutoText:=True, ShowValue:=True
      .MarkerBackgroundColorIndex = 1 'xlNone
      .MarkerForegroundColorIndex = 1
      .MarkerStyle = xlTriangle ' xlNone
      .MarkerSize = 4
      With .DataLabels
        .AutoScaleFont = True
        .Position = xlLabelPositionAbove
      End With
      With .Border
        .LineStyle = xlNone
      End With
    End With
   
   
    .SeriesCollection.NewSeries
    With .SeriesCollection(4)
      .Name = "Alarm"
      .Values = "=KonvData!R2C9:R" & r & "C9"
      .XValues = "=(KonvData!R2C5:R" & r & "C5)"
      .ChartType = xlLineMarkers
      .AxisGroup = 2
      .ApplyDataLabels AutoText:=True, ShowValue:=True
      .MarkerBackgroundColorIndex = 3
      .MarkerForegroundColorIndex = 3
      .MarkerStyle = xlX
      .MarkerSize = 5
      With .DataLabels
        .AutoScaleFont = True
        .NumberFormat = "0.00""%"""
        .Position = xlLabelPositionAbove  ' xlLabelPositionRight
      End With
      With .Border
        .LineStyle = xlNone
      End With
    End With
       
    With .Axes(xlCategory, xlPrimary)
      .HasTitle = True
      With .AxisTitle
        .Characters.Text = "Tid og Dato"
        .Top = 400
        .Left = 320
      End With
    End With
       
    .HasAxis(xlCategory, xlSecondary) = True
    With .Axes(xlCategory, xlSecondary)
      .HasTitle = True
      With .AxisTitle
        .Characters.Text = "Recept"
        .Top = 10
        .Left = 333
        With .Font
          .FontStyle = "Normal" '"Halvfet"
          .Size = 12
        End With
      End With
    End With
   
    With .Axes(xlValue, xlPrimary)
      .HasTitle = True
      .AxisTitle.Characters.Text = "Volum"
      With .TickLabels
        .NumberFormat = "0"" liter""": .Font.Size = 8
      End With
    End With
   
    With .Axes(xlValue, xlSecondary)
      .HasTitle = True
      .AxisTitle.Characters.Text = "Bvol%"
      With .TickLabels
        .NumberFormat = "0.0"" %""": .Font.Size = 8
      End With
    End With
    .ChartArea.Select
  End With
End Sub

Puha, sikker dog du knokler ;-)

Jeg har endnu ikke haft tid til at kigge på din kode og når det nok heller ikke i dag. Men jeg går på ferie fra i dag af, men jeg regner med at tage netop denne opgave med hjem, så jeg kan arbejde lidt videre med den, men tag højde for at jeg også trækker stikekt ud nogle dage, hvis du forstår ;-)

Hei Hei! Vi kan gå videre når du er tilbake.
Ønsker deg god ferie!

'*************************************************************
Hei  lsskaarup, er ferien snart slutt :-)


Har jobbet litt med din kodesnutt.
Sender over helt ny kode, så du bør slette den gamle koden først.
Først kommer kode for deklarasjonsmodul, hovedmodul og til siste Prosedyremodulen.

Option Explicit
Option Base 1

Public n As Long, i As Long, s As Long, r As Long
Public c As Object

Public sFolder As String
Public sTxtFile As String
Public vArkNavn() As Variant
Public sTittel As String
Public dDato As Date

Public lStartRadPost As Long
Public lRaderMellomHverPost As Long
Public lPostCounter  As Long
Public vRowColOffst() As Variant
Public sControl As String

Public wb As Workbook
Public ws As Worksheet
Public chrt As Chart
Public rng As Range

Public vEtikett() As Variant
Public vdB() As Variant

Public vTmp() As Variant
Public lFLR() As Long
Public vDTF() As Variant
Public vNFA() As Variant
Public vBorder() As Variant
Public vCC() As Variant
Public vYXKol() As Variant

Public vSerieProp() As Variant
Public vAxProp() As Variant

Option Explicit
Option Base 1

Public Sub HovedRutine()
  sFolder = "c:/temp/"
  sTxtFile = "test.txt"
  vArkNavn = Array("TxtData", "KonvData", "Diagram")
  sTittel = "Overskriften endres i Hovedrutinen :-)"
  sControl = "OK"
  lStartRadPost = 1
  lRaderMellomHverPost = 18
 
  vRowColOffst = Array(Array(15, 0, 1, 1, 4, 4, 5, 5, _
                              8, 8, 7, 9, 10, 10, _
                            11, 12, 12, 13, 14, 14), _
                        Array(1, 2, 3, 4, 1, 0, 2, 5, _
                              2, 1, 2, 2, 3, 4, _
                              2, 3, 4, 3, 1, 0))

  vEtikett = Array( _
  "n", "iTot", "iTotA", "iTotB", "iDato", "iTid", "Resept", "iBvol%", _
  "aDato", "aTid", "aBvol%", "nTot", "nTotA", "nTotB", _
  "SubT", "SubA", "SubB", "nBvol%", "eDato", "eTid", _
  "Resept", "Varighet", "l / time", "SubT", "SubA", "SubB")

  vDTF = Array(Array(Array(5, 9, 19), Array("-", ".")), _
              Array(Array(6, 10, 20), Array(".", ":")))

vNFA = Array( _
Array(Array( _
2, 12), Array(5, 9, 19), Array(6, 10, 20), Array(7), Array(8), Array(22), Array(23)), _
Array(Array( _
4, 14), Array(5, 9, 19), Array(6, 10, 20), Array(7), Array(8), Array(22), Array(23)), _
Array("0"" """, "d. mmm.", "hh:mm;@", """Nr. ""0", "0"" %""", "0"" min.""", "0"" """), _
Array(xlRight, xlCenter, xlCenter, xlCenter, xlCenter, xlRight, xlRight))

  vCC = Array(Array(0, 0, -1, 0, 0), _
              Array(1, 6, 11, 20, 23), _
              Array(3, 2, 3, 1, 3))
             
  vBorder = Array(xlEdgeLeft, xlInsideVertical, xlEdgeRight)
 
  vYXKol = Array(Array(16, 17, 15, 11, 23), _
                Array(19, 19, 19, 21, 19), _
                Array(20, 20, 20, 22, 20))

  vSerieProp = Array( _
    Array("SubA", "SubB", "SubTot (liter)  ", "Alarm(Bvol%)", "Liter/time  "), _
    Array(xlPrimary, xlPrimary, xlPrimary, xlSecondary, xlPrimary), _
    Array(xlColumnStacked, xlColumnStacked, xlLineMarkers, xlLineMarkers, xlLineMarkers), _
    Array(0, 0, 1, 3, 4), _
    Array(, , xlNone, xlNone, xlContinuous), _
    Array(, , 2, 8, 5), _
    Array(, , xlDash, xlX, xlCircle), _
    Array(0, 0, "0.0"" l""", "0.0""%""", 0))

  vAxProp = Array( _
  Array("Tid og Dato", "Recept, Produksjon og Tids-forbruk", "", """Nr. ""0", 10), _
  Array("Volum", "aBvol%", "0"" liter""", "0.0"" %""", 8))
                 
  Call OpneTextFilen
  Call OrdneTxtFil
  If sControl = "FEIL" Then: Exit Sub
  Call DataFraTekstFilTilMatrise
  Call LukkOrdnetOpneOrginalTxtFil
  Call DataTilRegneark
  Call DataTilOvreRad
  Call FormaterKolonnerMedDatoTid
  Call KalkulerCelleVerdier
  Call FormaterRegneark
  Call LagDiagram
 
End Sub

Option Explicit
Option Base 1


Public Sub OpneTextFilen()
 
  Workbooks.OpenText Filename:=sFolder & sTxtFile, Origin:=xlWindows, _
                  DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                  ConsecutiveDelimiter:=True, Semicolon:=True, Comma:=True, _
                  Tab:=True
 
  Set wb = ActiveWorkbook
  wb.Sheets(1).Name = vArkNavn(1)
 
End Sub



Public Sub LukkOrdnetOpneOrginalTxtFil()
 
  wb.Saved = True
  wb.Close
  Workbooks.OpenText Filename:=sFolder & sTxtFile, Origin:=xlWindows, _
                                      DataType:=xlDelimited, Tab:=True
 
  Set wb = ActiveWorkbook
  If sControl = "OK" Then wb.Sheets(1).Name = vArkNavn(1)
 
End Sub



Public Sub DataFraTekstFilTilMatrise()
 
  ReDim vdB(lPostCounter, UBound(vRowColOffst(1), 1))
  With wb.Sheets(vArkNavn(1))
   
    For n = 1 To lPostCounter
      For i = 1 To UBound(vRowColOffst(1), 1)
        vdB(n, i) = .Cells(lStartRadPost, 1).Offset( _
                        vRowColOffst(1)(i), vRowColOffst(2)(i))
      Next
      lStartRadPost = lStartRadPost + lRaderMellomHverPost
    Next
   
  End With
End Sub



Public Sub DataTilRegneark()
 
  Set ws = wb.Worksheets.Add
  With ws
    .Name = vArkNavn(2)
    .Cells(2, 1).Resize(, UBound(vEtikett, 1)) = vEtikett()
    .Cells(3, 1).Resize(UBound(vdB, 1), UBound(vdB, 2)) = vdB()
    r = Cells(Rows.Count, Cells(3, Columns.Count).End(xlToLeft).Column).End(xlUp).Row
 
  End With
End Sub



Public Sub OrdneTxtFil()
 
  lPostCounter = 0
  With wb.Sheets(vArkNavn(1))
   
    For n = 1 To 3
      For r = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
        If n = 1 And .Cells(r, 1).Value = "" Then
          .Cells(r, 1).EntireRow.Delete
        ElseIf n = 2 And .Cells(r, 1).Value = "Bvol" Then
          .Rows(r - 4 & ":" & r + 1).Delete
        ElseIf n = 3 And .Cells(r, 1).Value = "END" Then
          If Not .Cells(r, 1).Offset(9, 0).Value = "ALARM" Then
            .Rows(r + 8 & ":" & r + 9).Insert
          End If
          .Rows(r + 1 & ":" & r + 2).Insert
          lPostCounter = lPostCounter + 1
          s = r
        End If
      Next
    Next
   
    Select Case s
      Case 7
        .Rows("1:9").Insert
      Case 9
        .Rows("1:7").Insert
      Case 14
        .Rows("8:9").Insert
      Case Else
        sControl = "FEIL": s = 1
    End Select
   
    .Cells(19, 1).Select
    If sControl = "OK" Then
      r = -2
      For n = 1 To lPostCounter
        r = r + lRaderMellomHverPost
        If .Cells(r, 1).Value = "END" Then
          .Cells(r, 2).Value = n
        Else
          sControl = "FEIL": s = n
          Exit For
        End If
      Next
      lPostCounter = lPostCounter + 1
    End If
   
  End With
 
  If sControl = "FEIL" Then
    Call LukkOrdnetOpneOrginalTxtFil
   
    With wb.Sheets(1)
      r = .Cells(Rows.Count, 1).End(xlUp).Row
      n = 0: i = 1
      For Each c In .Cells(1, 1).Resize(r)
        If Left(c.Text, 3) = "END" Then
          n = n + 1
          If n = s - 1 Then i = c.Row
          If n = s Then r = c.Row: Exit For
        End If
      Next
      Range(.Cells(i, 1), .Cells(r, 6)).Select
    End With
   
    MsgBox "Programmet kan ikke tolke Tekstfila" & Chr(10) _
      & "Det første område med problemer er merket" & Chr(10) _
      & "Prøv å rette opp avviket, lagre så fila som teksfil " & Chr(10) _
      & "Prøv så på nytt "
  End If
End Sub



Public Sub DataTilOvreRad()
  With ws
    If .Cells(3, 2).Value = "" And .Cells(3, 12).Value = .Cells(4, 2).Value Then
      For n = 2 To 4
        Set c = .Cells(3, n)
        c.Value = c.Offset(0, 10).Value - c.Offset(0, 13).Value
      Next
     
      vTmp = Array(5, 7, 8)
      For n = 1 To 3
        Set c = .Cells(3, vTmp(n))
        c.Value = c.Offset(1, 0).Value
      Next
     
      With [B3:E3 , G3:H3]
        .Font.ColorIndex = 16
        .Font.Italic = True
      End With
    End If
  End With
End Sub




Public Sub FormaterKolonnerMedDatoTid()
  With ws
    '*** ERSTATTER UGYLDIGE TEGN I KOLONNER MED DATO OG TID
    For n = 1 To UBound(vDTF(), 1)
      For i = 1 To UBound(vDTF(n)(1), 1)
        Range(.Cells(3, vDTF(n)(1)(i)), .Cells(r + 1, vDTF(n)(1)(i))).Replace _
              What:=vDTF(n)(2)(1), Replacement:=vDTF(n)(2)(2)
      Next
    Next
   
    '*** TVANGSFORMAT AV VANSKELIG DATO, TAR OGSÅ BORT LIKE DATOER
    For n = 1 To UBound(vDTF(1)(1), 1)
      s = 1
      For Each c In Range(.Cells(3, vDTF(1)(1)(n)), .Cells(r + 1, vDTF(1)(1)(n)))
        c.Value = Format(c.Value, "mm.dd.yyyy")
        If Not c.Value = "" Then c.Value = CDate(c.Value)
        If Not c.Row = r + 1 And (c.Value = c.Offset(-s, 0).Value Or c.Value = "") Then
          c.Value = "": s = s + 1
        Else: s = 1
        End If
      Next
    Next
    dDato = .Cells(3, vDTF(1)(1)(UBound(vDTF(1)(1), 1))).Value
  End With
End Sub



Public Sub KalkulerCelleVerdier()
  With ws
    .Cells(1, 1).Value = sTittel & "  " & Format(dDato, "d. mmmm  yyyy")
    n = 0 ' FINNER ANTALL RESEPTER
    For Each c In Range(.Cells(3, 7), .Cells(r, 7))
      If Not (c.Value = c.Offset(-1, 0).Value) Then n = n + 1
    Next
    ReDim lFLR(n, 2)
   
    n = 0 ' FINNER START OG SLUTT RAD FOR HVER RESEPT
    For Each c In Range(.Cells(3, 7), .Cells(r, 7))
      If Not c.Value = c.Offset(-1, 0).Value Then
        n = n + 1
        lFLR(n, 1) = c.Row
      End If
      If Not c.Value = c.Offset(1, 0).Value Or c.Row = r Then
        lFLR(n, 2) = c.Row
      End If
    Next
   
  ' TO ALTERNATIVER FOR KALKULASJON AV TOT, SUB A OG SUB B-PRODUKSJON
  ' BENYTT IKKE BEGGE ALT. TIL SAMME TID.
 
  ' ALTERNATIV 1: BENYTTER TOT-VERIDENE I TELLEVERKET ( ANBEFALER IKKE DENNE )
'    For n = 1 To UBound(lFLR(), 1)
'      For i = 0 To 2
'        .Cells(lFLR(n, 1), 24 + i).Value = _
'        .Cells(lFLR(n, 2), 12 + i).Value - .Cells(lFLR(n, 1), 2 + i).Value
'      Next
'    Next

    'ALTERNATIV 2: SUMMERER SUBTOT SUB A OG SUB B FOR HVER RESEPT.
    For n = 1 To UBound(lFLR(), 1)
      Set rng = Range(.Cells(lFLR(n, 1), 15), .Cells(lFLR(n, 2), 15))
      For i = 0 To 2
        .Cells(lFLR(n, 1), 24 + i).Value = _
        Application.WorksheetFunction.Sum(rng.Offset(, i))
      Next
    Next
   
    'RESEPT NR. OG TOT-PRODUKSJON FOR RESEPTEN
    For Each c In Range(.Cells(3, 21), .Cells(r, 21))
      If Not c.Offset(0, -14).Value = "" Then
        c.Value = "Nr. " & c.Offset(0, -14).Value & " - " _
                        & Format(c.Offset(0, 3).Value, "0") & " liter"
      End If
    Next
       
  'TIDSFORBRUK I MINUTTER MELLOM HVER PRODUKSJON
    For Each c In Range(.Cells(3, 22), .Cells(r, 22))
      If c.Offset(0, -16).Value = "" Or c.Offset(0, -7).Value < 1 _
      Or c.Offset(0, -16).Value > c.Offset(0, -2).Value Then
        c.Value = ""
      Else
        c.Formula = _
        (c.Offset(0, -2).Value - c.Offset(0, -16).Value) * 24 * 60
      End If
    Next
   
    'PRODUKSJON I LITER PR. TIME
    For Each c In Range(.Cells(3, 23), .Cells(r, 23))
      If Not c.Offset(0, -1).Value = "" Then
        c.Formula = c.Offset(0, -8).Value / _
          (c.Offset(0, -3).Value - c.Offset(0, -17).Value) / 24
      End If
    Next
   
  End With
End Sub



Public Sub FormaterRegneark()
 
  With ws
    .Cells.HorizontalAlignment = xlCenter
    .Cells(1, 1).Resize(, UBound(vEtikett, 1)).MergeCells = True
    .Cells(2, 1).Resize(, UBound(vEtikett, 1)).Interior.ColorIndex = 15
   
   
    '*** NUMBERFORMAT OG ALIGN AV KOLONNER
    For n = 1 To UBound(vNFA(1), 1)
      For i = 1 To UBound(vNFA(1)(n), 1)
        With Range(.Cells(3, vNFA(1)(n)(i)), .Cells(r + 1, vNFA(2)(n)(i)))
          .NumberFormat = vNFA(3)(n)
          .Cells.HorizontalAlignment = vNFA(4)(n)
        End With
      Next
    Next
   
   
    .Rows(r + 1 & ":" & r + 3).Insert

    '*** FJERNER OVERFLØDIG DATA, MERKER OMRÅDET MED GRÅ FARGE
    For n = 1 To UBound(lFLR(), 1)
      If Not lFLR(n, 1) = lFLR(n, 2) Then
        Set rng = Range(.Cells(lFLR(n, 1) + 1, 1), .Cells(lFLR(n, 2), 1))
        For i = 1 To UBound(vCC(1), 1)
          With rng.Offset(vCC(1)(i), vCC(2)(i)).Resize(, vCC(3)(i))
            .ClearContents
            .Interior.ColorIndex = 15
          End With
        Next
      End If
    Next
   
    '*** HORISONTALE KANTLINJER
    For Each c In Range(.Cells(3, 7), .Cells(r + 1, 7))
      If Not c.Value = "" Or c.Row = r + 1 Then
        .Cells(c.Row, 1).Resize(, UBound(vEtikett, 1)) _
        .Borders(xlEdgeTop).LineStyle = xlContinuous
      End If
    Next
   
    '*** VERTIKALE KANTLINJER
    With Range(.Cells(2, 1), .Cells(r, UBound(vEtikett, 1)))
      For n = 1 To UBound(vBorder(), 1)
        .Borders(vBorder(n)).LineStyle = xlContinuous
      Next
    End With
   
   
    .Cells.Columns.AutoFit
    .Cells(2, 1).Select
  End With
End Sub


Public Sub LagDiagram()
 
  '*** TESTER OM DET HAR VÆRT ALARM
  s = 0
  For Each c In Range(ws.Cells(3, 11), ws.Cells(r, 11))
    If Not c.Value = "" Then s = 1
  Next
 
  '*** HVIS IKKE ALARM, MÅ EGENSKAP TIL DATASERIE ENDRES
  If s = 0 Then vSerieProp(4)(4) = 0: vSerieProp(8)(4) = 0
 
  Set chrt = wb.Charts.Add
  With chrt
    .Name = vArkNavn(3)
    .HasTitle = True
    .ChartTitle.Characters.Text = sTittel _
              & Chr(10) & Format(dDato, "d. mmmm yyyy")

    .Legend.Position = xlBottom

    For n = 1 To UBound(vYXKol(1), 1)
     
      If n > 1 Then .SeriesCollection.NewSeries
      With .SeriesCollection(n)
        .Name = vSerieProp(1)(n)
        .Values = Range(ws.Cells(3, vYXKol(1)(n)), ws.Cells(r, vYXKol(1)(n)))
        .XValues = Range(ws.Cells(3, vYXKol(2)(n)), ws.Cells(r, vYXKol(3)(n)))

        .AxisGroup = vSerieProp(2)(n)
        .ChartType = vSerieProp(3)(n)

        If Not vSerieProp(4)(n) = 0 Then
          .Border.ColorIndex = vSerieProp(4)(n)
          .Border.LineStyle = vSerieProp(5)(n)
          .MarkerBackgroundColorIndex = vSerieProp(4)(n)
          .MarkerForegroundColorIndex = vSerieProp(4)(n)
          .MarkerSize = vSerieProp(6)(n)
          .MarkerStyle = vSerieProp(7)(n)
        End If

        If Not vSerieProp(8)(n) = 0 Then
          .ApplyDataLabels
          .DataLabels.Position = xlLabelPositionAbove
          .DataLabels.NumberFormat = vSerieProp(8)(n)
        End If
      End With
    Next

    .HasAxis(xlCategory, xlSecondary) = True
    For n = xlCategory To xlValue
      For i = xlPrimary To xlSecondary
        With .Axes(n, i)
          .HasTitle = True
          .AxisTitle.Characters.Text = vAxProp(n)(i)
          .TickLabels.NumberFormat = vAxProp(n)(i + 2)
          .TickLabels.Font.Size = vAxProp(n)(5)
        End With
      Next
    Next
    .ChartArea.Select
  End With
End Sub

Her er det veldig mye som kan gå galt. Det som mest sannsynlig vil skape problemer er å få ordnet tekstfilen korrekt. Her lagt inn en kontrollrutien som skal gjøre feilrettingen lettere.

Er også bange for formateringen av dato. Den kan variere fra operativsystem til operativsystem. Dato formatet kan også fungere for enkelte datoer, men feile på andre. Det blir spennende å se.

Hvis vi er heldige har vi kommet halveis :-)
Dette er den siste dagen min forran pc-en på en stund, 2-3 uker, så LYKKE TIL.

PS! HUSK Å ENDRE FOLDER OG FILNAVN, DIAGRAMTITTEL ENDRES PÅ SAMME STED

Kigger på det i næste uge engang, har lige en lille ferie i denne også ;-) og der er jo altid noget vigtigt at gøre når man kommer tilbage.

Hej  lsskaarup, har du fått testet den nye koden?

Nej, og undskyld, men jeg har simpelthen ikke haft tid endnu.

Hej  lsskaarup, jeg skjønner du har mye å gjøre så jeg sender deg et svar,
slik at du får avsluttet spørsmålet.

Du bør lime inn koden, slik at du får se diagrammet, det tar jo bare et par minutter.

oyejo

Jeg regner med at få tid til det i morgen

Så har jeg endelig fået tid til at prøve din kode af. Desværre fejler den.

Smart at du har sat den til at markere området, som den fejler i. Det kommer her.

END       


Total    : 32336.49       
Total A    B: 25869.48    6467.01
SubTotal    : 0       
SubTotal A    B: 0    0
10.38:37  19-03-04       
Recept Nr. 2  Bvol %  25       
START       


Ojeblikkel. Bvol 22.69       
ALARM 10.42:31 19-03-04       


Total    : 32343.09       
Total A    B: 25874.76    6468.33
SubTotal    : 6.73       
SubTotal A    B: 5.38    1.34
Gnms. B volume: 25.04       
10.42:37  19-03-04       
END

Heisann!
Tror jeg ser feilen.
Nest nederste linje 25.04
istedet for et tall, % tror den det er en dato
benytter du samme PC som forrigen gang?
hvilken verjson av excle benytter du?
Jeg skal ta en titt på problemet i kveld.

Public Sub OpneTextFilen() 
                 
  Workbooks.OpenText Filename:=sFolder & sTxtFile, Origin:=xlWindows, _
          StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
          ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, Comma:=True, _
          Space:=False, Other:=False,  _
          FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2),  _
          Array(5, 2), Array(6, 1)), TrailingMinusNumbers:=True
                 
                 
                 
 
  Set wb = ActiveWorkbook
  wb.Sheets(1).Name = vArkNavn(1)
 
End Sub

har endret litt på den ene prosedyren, men det er vanskelig å vite, for det fungerer perfekt her på min maskin. xp og windows 2003

Hjemme har jeg windows og excel 2000 , jeg skal teste ut koden der

det er mulig du må ta bort:  ,TrailingMinusNumbers:=True
er ikke sikkert det er definert i eldre versjoenr

hvis du endrer talle 25.04 til 25.13 da vil den ikke tro der er en dato.
hvis du kunne gjøre det og så lagre txt-fila. hadde vi fått sjekket ut om problemet ligger der

Prøvede at ændre til 25.13, så fejlede den ikke i så stort et område, så prøvede jeg også at ændre tallet der (25.03), men det har ikke hjulpet. Prøver lige at indsætte din sidste kodestump.

Jeg bruger Windows XP med Office 2000

Det hjælper heller ikke med den nye OpneTextFilen(), TrailingMinusNumbers kan jeg heller ikke bruge, så den fjernede jeg

jeg har  Office 2000 hjemme. skal prøve der.
vet fra før at det er forskjell på hvordan
excel 2000 og excel 2003 tolker dato når tekstfiler blir åpnet.

vi kan prøve å legge til denne koden:
DecimalSeparator:=".",


Da blir det slik:

Public Sub OpneTextFilen()
 
  Workbooks.OpenText Filename:=sFolder & sTxtFile, Origin:=xlWindows, _
                  DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                  ConsecutiveDelimiter:=True, Semicolon:=True, Comma:=True, _
                  DecimalSeparator:=".", Tab:=True
 
  Set wb = ActiveWorkbook
  wb.Sheets(1).Name = vArkNavn(1)
 
End Sub

hvis du har tid til å prøve dette i begger versjoner før kl. 16 00,
hadde det vært fint

Dette fikser vi :-)

VIKTIG!
kom til å tenke på, du kunne jo åpne text-fila før
eneste forskjellen jeg kan se,
Space:=True
Da skulle det bli slik


Public Sub OpneTextFilen()
 
  Workbooks.OpenText Filename:=sFolder & sTxtFile, Origin:=xlWindows, _
                  DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                  ConsecutiveDelimiter:=True, Semicolon:=True, Comma:=True, _
                  Space:=True , Tab:=True
 
  Set wb = ActiveWorkbook
  wb.Sheets(1).Name = vArkNavn(1)
 
End Sub

Da har jeg prøvd koden på min pc hjemme.
Jeg fikk da de samme problemer som de du har.
Fant også at en annen feil.
Bytt ut den første linjen med den nedenfor (sFolder)

Hvis du i tillegg setter inn de to prosedyrenen nednfor,
kan det kanskje begynne å skje ting


sFolder = "c:/temp/" ' slik er det nå
sFolder = "C:\temp\" ' slik bør det være

Public Sub OpneTextFilen()

  Workbooks.OpenText Filename:=sFolder & sTxtFile, Origin:=xlWindows, _
            DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=True, Semicolon:=True, Comma:=True, _
            DecimalSeparator:=".", Tab:=True

  Set wb = ActiveWorkbook
  wb.Sheets(1).Name = vArkNavn(1)

End Sub

Public Sub LukkOrdnetOpneOrginalTxtFil()
 
  wb.Saved = True
  wb.Close
  Workbooks.OpenText Filename:=sFolder & sTxtFile, Origin:=xlWindows, _
            DataType:=xlDelimited, DecimalSeparator:=".", Tab:=True
 
  Set wb = ActiveWorkbook
  If sControl = "OK" Then wb.Sheets(1).Name = vArkNavn(1)
 
End Sub

Den fejler stadig

Ojeblikkel. Bvol 21.99       
ALARM 10.38:20 19-03-04        
Total    : 32336.49       
Total A    B: 25869.48    6467,01
SubTotal    : 4.95       
SubTotal A    B: 3.96    0,99
Gnms. B volume: 25.13       
10.38:36  19-03-04       
END

Kan du sende txt-filen som skal åpnes til meg?
Så kan jeg teste her hos meg,
Hvis jeg lykkes, kan jeg sende tilbake
både excel bok med kode og excelbok med data

jeg har sendt deg exelfilen, slik det blir oppretter her hos meg.

Øh, nu prøvede jeg at ændre OpneTextFilen tilbage til én af de tidligere udgaver, selvfølgelig virkede det ikke.

Det mærkelige er så, at jeg kun ændrede OpneTextFilen, for senere at ændre den tilbage til din seneste udgave, men nu fejler den et andet sted.

Nu får den nemlig hentet det hele ind, og formateret det, men komemr så med en debug-fejl i denne linie:

If Not c.Value = "" Then c.Value = CDate(c.Value)

Helt præcist i delen

Then c.Value = CDate(c.Value)

Hvis problemet ligger her, greier den ikke å tolke datoen
If Not c.Value = "" Then c.Value = CDate(c.Value)


har du lagt inn koden min fra: 22/09-2005 07:39:14?
spesielt: DecimalSeparator:=".", kan være viktig

Her sendt textfilen til dig

har sett på din txtfil

Den feiler også hos meg, kan det være at filen har
vært åpnet i excel før og så lagret som txt-fil?

har du en tekstfil som er orginal,
slik det blir lagret av sysemtemt

hvis du har, kan du prøve den.

Det skulle sådan set være den originale, men jeg prøver lige at tjekke de andre jeg har igennem.

Har sendt en anden fil, men den fejler også

jeg skal sjekke den,

Jeg har åpnet den filen jeg fikk fra deg før i dag, i notepad.
den ser ut til å mangle tabulator tegnet.

Hvis filen har vært åpnet i excel som tabulatordelt, og så lagret. har vi kanskje mistet et viktig skille tegn, slik at data kommer i feil celle


har sendt deg noen txt-filer, som jeg har fått fra deg. ( zippet)
disse har vi åpnet korrekt før

Hei lsskaarup

Er litt usikker på hvordan vi skal fortsette. (det blir ikke før mandag)
Sender deg tekstfilen "test.txt"  og en excelbok
som viser hvordan resultatet kan bli.

for meg ser det ut til at :
de txt-filene vi har problemer med har alle data i kolonne A.
tror vi har mistet noen skilletegn på veien

Hmm, det er da ikke utænkeligt. Jeg sender dig derfor filen, som jeg har diskette, og det ved jeg er originalen, den er aldrig blevet åbnet i andet end Notepad.

Wow, jeg skal lige gennemskue tallene i diagrammet, men det ligner præcist, sådan noget jeg havde forestillet mig. Har du lavet det via makro-knappen eller er det lidt manuelt arbejde?

makroen lager hele diagrammet,ikke noen manuelt her i gården nei :-)
skal ta en titt på filen i ettermiddag

Det er sgu i orden. Jeg printer lige en ud, så han kan se, hvordan det ca. kommer til at se ud.

Jeg måtte legge inn space som separator i tillegg. da fungerer det her.
Sender over de to prosedyrene som er revidert. (kanskje for siste gang ;-)

Public Sub OpneTextFilen()

  Workbooks.OpenText Filename:=sFolder & sTxtFile, Origin:=xlWindows, _
                  DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                  ConsecutiveDelimiter:=True, Semicolon:=True, Comma:=True, _
                  Space:=True, DecimalSeparator:=".", Tab:=True

  Set wb = ActiveWorkbook
  wb.Sheets(1).Name = vArkNavn(1)

End Sub



Public Sub LukkOrdnetOpneOrginalTxtFil()
 
  wb.Saved = True
  wb.Close
  Workbooks.OpenText Filename:=sFolder & sTxtFile, Origin:=xlWindows, _
        DecimalSeparator:=".", DataType:=xlDelimited, Space:=True, Tab:=True
 
  Set wb = ActiveWorkbook
  If sControl = "OK" Then wb.Sheets(1).Name = vArkNavn(1)
 
End Sub

Så fejler den ved
Set wb = ActiveWorkbook

hov mangler
i OpneTextFilen()

litt språkproblemer, hov mangler... hva betyr det?
Skal jeg sende hele makroboken til deg?

Det var bare fordi jeg fik trykket på send, før jeg har helt færdig med at skrive indlæget.

Der skulle have stået:

Så fejler den i

Set wb = ActiveWorkbook

i OpneTextFilen()

Hva skjer hvis du tar bort disse to linjer
setter dem som kommentar

'Set wb = ActiveWorkbook
'wb.Sheets(1).Name = vArkNavn(1)
blir da tekstfilen åpnet før den feiler?

Så kommer data ind og bliver stillet pænt op, dog kommer der intet diagram, hvis der skulle det.

1) Sjekk at dette står øverst i alle dine moduler:

Option Explicit
Option Base 1

2) hvis det ikke hjelper, kontroller at Declarasjone er slik som angitt i:

Kommentar: oyejo
10/08-2005 07:37:52

Koden skal inn i declarasjonsmodulen

Okay, der er vist gået noget helt galt i min kode. Jeg prøver lige at starte forfra fra kommentaren den 10/08-2005 07:37:52

Okay, så har jeg kørt det igennem igen, men får stadigvæk fejl. Denne gang er det en

Run-time error 13 type mismatch

og debug'er jeg, så er markere den c.Value = CDate(c.Value) i FormaterKolonnerMedDatoTid() i Procedure.

Jeg sender lige begge filer til dig.

har problemer med å logge meg på hotmail, skal prøve i morgen.

Hvis du har satt inn all kode fra 10/08

har du erstattet to av prosedyrene fra i dag:
Kommentar: oyejo
27/09-2005 10:30:24

Problemet er trolig at din kode ikke gjenkjenner datoformatet

det er spesielt viktig at denne er med:
DecimalSeparator:=".",

kan du prøve å sende import.xls en gang til?
Når jeg prøver å lagre den fra hotmail får jeg feilmeldig.
Har prøvd å laste ned filen flere ganger, men det er mislykket

Fikk lastet ned import.xls likevel OG...

DEN FUGERER UTMERKET!!!!!!!!!!

kan det være at det SKJER NOE MED TXT-FILEN NÅR DEN BIR SENT PÅ MAIL?
Jeg prøver å videresende fredag.txt så kan du se om du får åpent den.

NEI...

import.xls kunne åpen den txt-fila du sendte i i forgårs, men ikke den fredag.txt som ble sendt med nå.

Man kan se at txt-filene er forskjellig. den siste har noen celler i kolonne A som inneholder tallet 0.

Det stammer egentlig fra raden over.
Skal prøve å skirv om koden, slik at det fugerer.

Heisann!
Eksperten har vært nede, er det vi som har for mangen innlegg ;-) ca. 150 tror jeg.

Tror endelig jeg har funnet svaret:
Detter er deler av fredag.txt som du sendt meg for et par dager siden:
Ojeblikkel. Bvol 21.99
ALARM 10.38:20 19-03-04


Total    : 32336.49
Total A,B: 25869.48; 6467.01
SubTotal    : 4.95
SubTotal A,B: 3.96; 0.99
Gnms. B volume: 25.03
10.38:36  19-03-04
END


Total    : 32336.49
Total A,B: 25869.48; 6467.01
SubTotal    : 0
SubTotal A,B: 0; 0
10.38:37  19-03-04
Recept Nr. 2  Bvol %  25
START
Den er det ikke noe problem med.

Dette er deler av fredag.txt som du sendte meg i går:
Ojeblikkel. Bvol 21.99
ALARM 10.38:20 19-03-04

Total    : 32336.49
Total A,B: 25869.48; 6467.01
SubTotal    :
4.95
SubTotal A,B: 3.96; 0.99
Gnms. B volume: 25.03
10.38:36  19-03-04
END

Total    : 32336.49
Total A,B: 25869.48; 6467.01
SubTotal    : 0
SubTotal
A,B: 0; 0
10.38:37  19-03-04
Recept Nr. 2  Bvol %  25
START
denne feiler! Hva har skjedd?
Hvis man ser på klokkeslettet, skal det være samme filen!
men det har kommet noen ekstra linjeskift i den siste filen.

Det er derfor den feiler, tallene står ikke der de skal stå.
Så hvis du benytter orginal txt-fil skal programmet ditt fugerere.

Hvis du legger inn 3 ekstra linjer på slutten av hovedrutinen,
får du mere fart og diagrammet kan bli letter å lese, det kommer an på din skjerm
legger inn alle de siste linjene er det lettere å kopiere inn.

Application.ScreenUpdating = True
  Call OpneTextFilen
  Call OrdneTxtFil
  If sControl = "FEIL" Then: Exit Sub
  Call DataFraTekstFilTilMatrise
  Call LukkOrdnetOpneOrginalTxtFil
  Call DataTilRegneark
  Call DataTilOvreRad
  Call FormaterKolonnerMedDatoTid
  Call KalkulerCelleVerdier
  Call FormaterRegneark
  Call LagDiagram
  Application.ScreenUpdating = True
  Application.DisplayFullScreen = True

End Sub

Denn først linjen ble feil, skal være slik:
Application.ScreenUpdating = False

der er kun de to siste som skal være = True

Hvad fanden går der galt her. Ja, undskyld mit sprog, men det irriterer mig lidt.

Med de seneste kodelinier, fejler den stadig, præcist samme som i kommentar 27/09-2005 15:58:27.

Men jeg tror det skyldes txt-filen, for pludselig kan det ikke afgrænses med "|".

Gad vide om der sker et eller andet med filen, når jeg sender den til dig, for den du har sendt tilbage ligner ikke den jeg sendte til dig.

PRøver jeg at indlæse "Kopiaffredagoriginal.txt", så får jeg en anden fejl. Så kommer den der fejlmeddelelser, som du har lagt ind, og den markere alt ned til først END

vedr. din siste kommentar: kan du lime inn den teksten som blir markert

du har rett, det skjer noe med txt-filen
den versjoen av "Kopiaffredagoriginal.txt", 
som jeg lager som txt-fil direkte fra Hotmail er riktig.

Men når jeg fra hotmail sender din mail til min firma e-post
og lagrer "Kopiaffredagoriginal.txt", som vedlegg, ER DEN ENDRET !
DET ER KOMMET TIL NOEN EKSTRA LINJESKIFT.

DET KAN JO OGSÅ VÆRE FLERE ENDRIGER SOM IKKE ER SÅ LETTE Å SE

Markeringen ved fejl:

Ojeblikkel.    Bvol    21,99       
ALARM    10.38:20    19-03-04       

Total    :    32336,49       
Total    A    B:    25869,48    6467,01
SubTotal    :           
4,95               
SubTotal    A    B:    3,96    0,99
Gnms.    B    volume:    25,03   
10.38:36    19-03-04           
END               

Jeg tror nu også der går noget galt, når jeg modtager din mail, for

SubTotal    :
4.95

står pludselig på 2 linier.
Hvad kan vi gøre for at undgår dette, zippe den?

Ja feilen her, er at en linje kommer over to linjer.
denne filen går det ikke å benytte lengre.

hvis vi skal videre må du finne en txt-fil som ikke har disse linjeskift.
du kan åpne filen i notepad for å sjekke dette.

å zippe kan være en mulighet. hvis den skal sendes.
hvis den sendes til en hotmail-adresse kan den sendes som en vanlig txt-fil
MEN HAR DEN DISSE LINJESKIFT, ER DET INGEN VITS I Å SENDE, DA ER DEN ØDELAGT.

HVIS DU HAR EN TXT-FIL UTEN EKSTRA LINJER, SOM FEILER PÅ ET ANNET FELT.
SE OM DET HJELPER Å ÅPNE I NOTEPAD, SÅ KAN DU :

1) velg Merk Alt ( ctrl+A)
2) kopier
3) lukk filen

4) åpne så wordpad
5) lim inn
6) lagre som txt-fil

se om den kan åpnes

wordpad ligger under Programmer- Tilbehør

Jeg ved godt hvordan jeg skal tjekke filen.

Hvis jeg tager en, hvor det ser korrekt ud, så laver den fejl i FormaterKolonnerMedDatoTid(), og helt præcist c.Value = CDate(c.Value).

Men derudover, så her filen noget jeg ikke kan huske om vi har snakket om. I én af de sidste linier, kommer der nemlig nogle mærkelige tegn, såsom þÿÿÿ.

du skriver:
I én af de sidste linier, kommer der nemlig nogle mærkelige tegn, såsom þÿÿÿ.
Tror ikke det skal skape noe problem.

Det som gjør det vanskelig er at din import.xls fungerer utmerket her.
Jeg skal ta den med hjem i dag å se om den også kjører under win2000

Hvis du kunne sende den txt-filer som gir feilmelding ved
c.Value = CDate(c.Value).
kunne jeg også teste ditt program mot denne tekstfil på win2000
Det er datoformatet som gir problemer.
jeg hadde win2000 på kontoret før, hadde noe kode som fugerte utmerket.
når jeg skiftet til xp- måtte jeg bruke mange timer på å rette i koden.

det under meg også litt at du kunne åpen txt-filer korrekt den
Kommentar: lsskaarup
12/07-2005 09:06:29

da har jeg testet din import.xls hjemme på min windos 2000 pc med excel 2000.
Den fungerer helt utmerket.
Diagrammet kommer opp slik det skal.

Det er det som gjør det så vanskelig, jeg har ingen feil å ta fatt i.
Den feilen som du nå beskriver, hadde også jeg på min hjemme-pc
før jeg endret opnetxt-fil prosedyren slik at den inneholdt:
DecimalSeparator:=".",
Men din import.xls hadde denn oppdateringen.
Kan ikke forstå annet ennn at våre pc-er tolker datoformatene forskjellig.

jeg trenger en tenkepause....:Q))

Ja, det kan jeg sku' godt forstå. Kan den have noget med hvordan maskinen er sat op, med hensyn til dato-formaterne?

det er jeg usikker på, jeg er jo bare en stakkars amatør :-)
men det kan tenkes.

vi kan jo prøve å endre denn linjen:
c.Value = Format(c.Value, "mm.dd.yyyy")
til
c.Value = Format(c.Value, "mm-dd-yyyy")

da skulle det bli slik:

Public Sub FormaterKolonnerMedDatoTid()
  With ws
    '*** ERSTATTER UGYLDIGE TEGN I KOLONNER MED DATO OG TID
    For n = 1 To UBound(vDTF(), 1)
      For i = 1 To UBound(vDTF(n)(1), 1)
        Range(.Cells(3, vDTF(n)(1)(i)), .Cells(r + 1, vDTF(n)(1)(i))).Replace _
              What:=vDTF(n)(2)(1), Replacement:=vDTF(n)(2)(2)
      Next
    Next
   
    '*** TVANGSFORMAT AV VANSKELIG DATO, TAR OGSÅ BORT LIKE DATOER
    For n = 1 To UBound(vDTF(1)(1), 1)
      s = 1
      For Each c In Range(.Cells(3, vDTF(1)(1)(n)), .Cells(r + 1, vDTF(1)(1)(n)))
        c.Value = Format(c.Value, "mm-dd-yyyy")
        If Not c.Value = "" Then c.Value = CDate(c.Value)
        If Not c.Row = r + 1 And (c.Value = c.Offset(-s, 0).Value Or c.Value = "") Then
          c.Value = "": s = s + 1
        Else: s = 1
        End If
      Next
    Next
    dDato = .Cells(3, vDTF(1)(1)(UBound(vDTF(1)(1), 1))).Value
  End With
End Sub

i tillegg til :
c.Value = Format(c.Value, "mm-dd-yyyy")
kan du også prøve denne:
c.Value = Format(c.Value, "dd-mm-yyyy")
det kan ogås være flere varianter

Nu tænkte jeg mere generelt, sådan i Windows og/eller Office, men vil da lige prøve og se om det andet virker.

ja det kan ligge i Windows og/eller Office også, men ja kan så lite om det.
men det går det jo an å lære, VI GIR OSS IKKE !:-)

Uhaaaaaaa, jeg ændrede datå til formatet "mm-dd-yyyy", og så virkede det. HAr så også ændret det til "dd-mm-yyyy", og det ser også ud til at virke. Nu skal jeg lige bruge lidt tid på at se om det vises rigtigt, og prøve at forklare brugeren hvordan diagrammet skal forstås.

Uhaaaaaaa  da er alt slitet glemt :-)
Og man skal ikke glemme, man lærer utrolig mye på denne måten.
i dansk datoformat må man benytte - og ikke . mellom dager,mnd og år.
i norsk format kan vi benytte begge deler.

Okay, skriver I også månederne først, siden mm kom først.

Jeg har dog nogle små ting, som jeg godt kunne tænke mig lige at hører om. Kan man gøre et eller andet, så de ikke kan komme til at overskrive original filen fra malerkabinen. Hver gang Excel lukkes, siger den jo at filen er blevet ændret og spørger om man vil gemme den. Og du kender sikkert brugere, på et eller andet tidspunkt, kommer de til at overskrive den, og så virker det jo ikke længere, og netop på det tidspunkt, skal de have lavet en kopi.

Hmmm, jeg tror lige, du skal komme med en forklaring på værdierne i både diagramet og det konverterede regneark.

Bl.a. tallet 32332 (32331,54) under iTot, kan jeg ikke finde nogle steder i det orindelige dokument.

Og den der l/time hvordan er du helt præcist kommet frem til den?

Okay, skriver I også månederne først, siden mm kom først.
Nei vi skriver opprinnelig dd.mm.åååå men fra nå av dd-mm-åååå ;-)

overskrive original filen fra malerkabinen
skal tenke ut noe her, det bør ikke være noe problem

Bl.a. tallet 32332 (32331,54) under iTot,
disse data eksisterer ikke, men programmet regner seg tilbake, det vet eTot og produksjon, så da kan man lett regne tilbake
PS! Før dette skjer, blir det testet om det er samme respept, ser at eTot på første måling er det samme som iTot på neste måling.

den regner ut tidsintervallet mellom to måinger og totalproduksjon er kjent
Dettte er med eventuelle pauser, men det gir et godt bilde.
Hvis du ser nøye på data, kan det se ut som kapasiteten på sprøyten er for liten.
Det er ofte høy produksjon før alarmen går.
Sprøyteren ser ut til å være arbeidssom, selv om alarmen går ofte, holder han produksjonen oppe ... slik ser det ut for meg ;-)

Hov, jeg udtrykte mig måske ikke tydeligt nok. Original filen må IKKE kunne bliver overskrevet.

Hvilke tal bruger den så for at komme frem til iTot, for den her jeg ikke lige kunnet gennemskue?

Jeg forstår stadig ikke den med liter/time. F.eks. de 108 l/time, hvad er det et udtryk for, og hvilke tal bruger den for at komme frem til resultatet.

Men jeg har vendt diagrammet med ham, der primært skal bruge det, og han er tilfreds. Han vil dog også gerne vil have en entydig forklaring på l/time ;-)

Hov, jeg udtrykte mig måske ikke tydeligt nok. Original filen må IKKE kunne bliver overskrevet.
Det var jeg som var uklar, jeg skjønte hva du mente men uttrykte meg klossete.

Normalt slik jeg forstår det. iTot er hva "telleverket" står på før produksjon
Hvis man tar iTot + SubT får man nTot. Som er "telleverket" etter produksjon.
når første iTot mangler, er det bare å renge tilbake nTot - SubT.

hvis du merker ut denne koden som kommentar, er det lettere å se.

'*** FJERNER OVERFLØDIG DATA, MERKER OMRÅDET MED GRÅ FARGE
    For n = 1 To UBound(lFLR(), 1)
      If Not lFLR(n, 1) = lFLR(n, 2) Then
        Set rng = Range(.Cells(lFLR(n, 1) + 1, 1), .Cells(lFLR(n, 2), 1))
        For i = 1 To UBound(vCC(1), 1)
          With rng.Offset(vCC(1)(i), vCC(2)(i)).Resize(, vCC(3)(i))
            .ClearContents
            .Interior.ColorIndex = 15
          End With
        Next
      End If
    Next

Normalt er det nok å vite hva "telleverket" står på før man starter på resepten.
den første iTot. og å vite hva telleverket står på etter siste produksjon for samme resepten. Alle de andre tall vil bare virke forstyrrende. ( det kan bli for mye tall)
derfor er de tatt bort.

liter/ time : her har jeg tatt en råtjanse :-), har antatt at SubT er totalt volum i liter som er sprøytet. foreksempel:

6,73 liter i celle O4.  Så blir tiden mellom iTid ( 10:38) og eTid (10:42) beregnet.
Da kan jeg regne ut i gjennomsnitt hvor stor produksjoen er.
Her er målet liter / time et greit mål.
I dette estimatet blir også evt. pauser inkludert. noe annet er ikke mulig.
Men det er likevel et meget godt verktøy når man skal gjøre anlalyser, mener jeg

Ellers så er koden delt opp i små moduler. jeg vil anbefale at du merker ut call setniger slik at bare deler av koden kjøres, da får du en god forståelse av hva som skjer.

og for den del det er ikke bare call setninger som kan merkes som kommentar.
gå også inn i selve koden for å se hva som skjer.

med hensyn til overskriving.
kan de ikke lage en rutine, slik at de aldri legger orginalfilene, men kopier i mappen som programmet skal benytte?

PS! det står noen tall i diagrammet.
Hvis det er tvil, for de måleserier som viser tall,
disse måleseriene har enhetene i parantes i forklaringen.

en siste liten kommentar.
når iTot og noen andre verdier blir berenget, er skrften grå og i kursiv, slik at man lett skal se at dette er tall som er beregnet.

Okay, nu tror jeg, jeg er helt med. For en sikkerhedsskyld så bliver størrelsen på værdierne på akserne ændret dynanisk. F.eks. hvis der kommer en værdi for aBvol%, som er lavere end 19%, så udvider aksen sig vel bare?

ja diagrammet skal være dynamisk.

min forklaring på liter / time var kanskje ikke så god, men...
det blir det samme som når man kjører bil, man leser farten i km / time
på sprøyta blir produksjonsfarten liter / time

Din forklaring på liter / time var helt fin. Jeg tror også det er noget som brugeren kan forstå. Jeg skal bare have fundet en løsning, så de ikke får overskrevet den originale fil, eventuelt forklaret i tydelige vendninger, hvordan de skal undgå det.

Skal komme med en løsning i løpet av ettermiddagen

Du bør skrive datoformatet som vi hadde problemer med slik:
c.Value = Format(c.Value, "mm-dd-yyyy")

vba er Amerikansk og de benytter dette formatet.
Skriver man dagen først, kan man få problemer med datoer < 12
dager og månder blir vekslet om.

Angående problermer med overskriving av orgianlfil.
Når excel har åpnet txt-filen og lagt til diagrammet, er det ikke lengre en txt-fil.
Den spør om du vil endre txt-filen, men selv om man svarer ja, blir ikke orginalfilen overskrevet.

Men hvis du likevel vil sikre at du har orgianldata, kan du benytte denne.
Den krever MS office 2000 eller senere.


Public Sub Backup()
'*********************************************************

'  Denne krever MS Office 2000 eller seneren versjoner
'  Tools-> References.. det skal være krysset av for
'  Microsoft Scripting Runtime
'  Hvis den ikke ses under Refernces, kan man se i :
'  C:\WINNT\System32\
'  filens navn : Scrrun.dll

'  Denne sub sjekkker om mappen med txt-filen har en subfolder
'  som heter Backup. Hvis ikke blir den opprettet.

'  DET ER VIKTIG AT ORGINALFILER IKKE BLIR LAGT I DENNE
'  BACKUP-FOLDER MANUELT. FOR DA BLIR DE OVERSKREVET



 
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set fsoFld = fso.GetFolder(sFolder)
 
  If Not fso.FolderExists(sFolder & "Backup") Then
    fso.CreateFolder (sFolder & "Backup")
  End If
 
  Set fsoFil = fsoFld.Files(sTxtFile)
  fsoFil.Copy (sFolder & "Backup\")
 
  Set fsoFld = fso.GetFolder(sFolder & "Backup\")
  Set fsoFil = fsoFld.Files(sTxtFile)
 
  n = 1
  Do While fso.FileExists( _
    fsoFld & "\" & Left( _
    fsoFil.Name, Len(fsoFil.Name) - 4) & "_nr" & n & ".txt")
    n = n + 1
  Loop
  fsoFil.Name = Left( _
  fsoFil.Name, Len(fsoFil.Name) - 4) & "_nr" & n & ".txt"

  Set fso = Nothing
  Set fsoFld = Nothing
End Sub

Legg 3 nye declarasjoner i Declarasjonsmodulen:
  Public fso As FileSystemObject
  Public fsoFld As Folder
  Public fsoFil As File

  Call Backup som første call setning i hovedprodesyren

Okay, retter dato-formatet tilbage

Tjekker lige op på, om der skal sikres imod overskrivning, men det bliver nok først i næsten uge jeg når det

Okay, her snakket med personen som skal bruge det, og han er faktisk ligeglad, så jeg stopper bare her. Her altså ikke indtastet det sidste du lavede, men rigtigt mange tak for hjælpen.

Vi burde få en præmie, for længste tråd... ;-)

ja da blir dette innlegg nr. 194 ikke dårlig :-)
.. det blir nesten litt vemodig å avlutte spørsmålet.
har faktisk lært mye på dette prosjektet!