Tekstitiedoston lataukseen nopeutta

aikaa manuaalinen makro koodi ;-)

jos nyt laittaist esim. otsikkorivin ja tietorivien rakenteen ja vähän tarkemman kuvauksen, ettei tartte rivi riviltä alkaa tulkkaan koodia ,niin Kunde voisi ehkä jelpata vaikkakin Mikkiksen vermeillä... ;-)

Kundepuu kirjoitti:

jos nyt laittaist esim. otsikkorivin ja tietorivien rakenteen ja vähän tarkemman kuvauksen, ettei tartte rivi riviltä alkaa tulkkaan koodia ,niin Kunde voisi ehkä jelpata vaikkakin Mikkiksen vermeillä... ;-)

Moikka taas

Tälläst tietooko haluaisit. "Auts" jos men mönkään. Tietoo on kerätty Apu -taulukkoon ja siitä tallennetaan. Alussa jokusia yksittäisiä soluja ja loppuosa kokonaan. Rivimäärä vaihtelee. Toi taulukon määrityksen rivimäärä on vielä "manuaalilla". Siin on muutaman rivin pelivara. Oliskos tästä apuu.

Dim i As Integer
Dim j As Integer
Dim vika_rivi2 As Double
Dim Apu(35, 35) As String

Open "C:\TPP\" & Right(Range("AI2"), 4) & "\" & Range("C3") & "\" & _ Range("AI3") & ".txt" For Output As #1
Print #1, Apu(2, 34); ";";
Print #1, Apu(2, 35)
Print #1, Apu(3, 3); ";";
Print #1, Apu(3, 5); ";";
Print #1, Apu(3, 6); ";";
Print #1, Apu(3, 7); ";";
Print #1, Apu(3, 35)
For i = 7 To vika_rivi2
For j = 2 To 35
Print #1, Apu(i, j); ";";
Next
Print #1, Chr$(10)
Next
Close #1

laita malli siitä tekstitiedostosta otsikkorivi dataa

No niin, tälläseltä se näyttäs.

Täs olis tekstitiedoston alku.
Alus yksittäisis soluis mukana seuraavaa tietoo, sitten
B-sar. Nimi
C-sar. Syntymäaika
D-AH sar. dataa 0, 1, p, s, pl (selityksiä eri päivälle)


22;1.6.2015
Ryhmä A;R28;30;35;Kesä
Nimi;Synt.aika;1;1;1;1;1;;;p;p;1;1;1;;;s;s;s;1;1;;;1;1;1;1;1;;;1;1;;

Sub HaeTiedot()
Dim a
Dim vika As Long
On Error GoTo virhe
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'muuta polku ja tiedostonnimi sopivaksi
With CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\Temp\Koe.txt")
Do While Not .AtEndOfStream
If .Line = 1 Then
a = Split(.ReadLine, ";")
Range("AH2") = a(0)
Range("AI2") = a(1)
Else
If .Line = 2 Then
a = Split(.ReadLine, ";")
Range("C3") = a(0)
Range("G3") = a(1)
Range("H3") = a(2)
Range("I3") = a(3)
Range("AI3") = a(4)
Else
Cells(.Line 3, 2).Value = .ReadLine
End If
End If
Loop
.Close
End With
vika = Range("B65536").End(xlUp).Row
Range("B7:B" & vika).TextToColumns Destination:=Range("B7"), DataType:=xlDelimited, Other:=True, OtherChar:=";", FieldInfo:=Array(1, 1)
virhe:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Keep EXCELing
@Kunde

Parii pientä viilausta kaipais. Jäipä sanomatta varmaankin, et rivin lopussa AI -sarakkeessa on Summa -kaava ja nyt se ladattaessa tuhoutuu. Sit se toinen. Tulostaa joka toiselle riville. Kiittelempä taas, sillä etköhän nuokin ratkase.

onko summakaava joka rivillä vaiko vaan ikalla rivillä?
miltä alueelta summaa?
siis tiedot jokatoiselle riville?

Summakaava on joka rivillä AI-sarakkeessa ja summaa alueen D-AH. Rivit tulostuu oikein (tarkistin sen kopioimalla summakaavan seuraavaan sarakkeeseen), mutta joka toinen rivi on tyhjä

Muutitko mitään koodiini?
Mulla kyllä tiedot tulee jokariville ja ei koodissani kyllä ole mitään "hypytystäkään".

Lisää summakaava ennen virhe: riviä
Range("AI7:AI" & vika).FormulaR1C1 = "=SUM(RC[-31]:RC[-1])"

Keep EXCELing
@Kunde

Jospa laittasin pienen yhteenvedon mitä täs tapahtuu.

Ekaks kuitenkin, että en oo muuttanu muuta kun ton tiedoston polun siit sun koodista.

Rivi 7. Tiedoston eka rivi tulostuu oikein sarakkeisiinsa, mutta kaavan poistaa lopusta (ihan niinkun ulottus yhen sarakkeen liian pitkälle).

Rivi 8 tyhjä

Rivi 9. Tiedoston toinen rivi. Kaikkien sarakkeiden arvot yhtä pötköö B9 sarakkeessa.

... ja näin jatkuu, joka toinen rivi tyhjä ja joka toinen yhes pötkös ekas sarakkeessa

Kaavat poistuu AI-sarakkeesta riviltä 7 riville 17 asti ja ovat riviltä 18 taas pelissä mukana.

Sitten tää tulostaa tyhjät rivitkin tiedostosta joka toiselle riville puolipistejonoina. (noi erottimet)


Kävi mieles, et oisko yhteensopimattomuutta noilla käskyillä excel 2013 kanssa.

Kyllä pitäisi toimia 2013 kanssa. Veikkaan vaan, että tekstitiedostosi ei ole antamasi kuvauksen mukainen kaikilta osin...
kaavat poistuu, koska teksti sarakkeisiin sen tekee ja ilmeisesti sinulla on 10 riviä tekstitiedostossa dataa ja siksi sen jälkeisiet kaava eivät poistu A1 sarakkeesta riviltä 18 alkaen. Et maininnut mitään tyhjistä riveistä tai ; pisterivistä(erotin)

oma tekstitiedostoni on tälläinen ja toimii moitteettomasti(testasin n. 10000 riviä ja vikkelästi toimii ;-)

22;1.6.2015
Ryhmä A;R28;30;35;Kesä
Nimi;Synt.aika;1;1;1;1;1;;;p;p;1;1;1;;;s;s;s;1;1;;;1;1;1;1;1;;;1;1;;
Nimi;Synt.aika;1;1;1;1;1;;;p;p;1;1;1;;;s;s;s;1;1;;;1;1;1;1;1;;;1;1;;
Nimi;Synt.aika;1;1;1;1;1;;;p;p;1;1;1;;;s;s;s;1;1;;;1;1;1;1;1;;;1;1;;
.
.
.
reilut 11000 riviä

no tein nyt sitten kirjoituskoodin kanssa, jotta muoto olisi varmasti sama kirjoittaessa ja lukiessa.
Ajattelin , etää kun summakaavan tulos =0 niin tarkoittanee tyhjää riviä ja sitä ei sitten tarvinne vai? Helppoahan se on hipsata koodista

Sub Kirjoittaa()
Dim vika As Long
Dim Solu As Range
Dim i As Long
vika = Range("B65536").End(xlUp).Row
'muuta polku ja tiedostonnimi sopivaksi
With CreateObject("Scripting.FileSystemObject").CreateTextFile("C:\Temp\Koe1.txt")
.Write (Range("AH2").Value & ";" & Range("AI2").Value)
.Write (vbNewLine)
.Write (Range("C3").Value & ";" & Range("G3").Value & ";" & Range("H3").Value & ";" & Range("I3").Value & ";" & Range("AI3").Value)
.Write (vbNewLine)
For i = 7 To vika
For Each Solu In Range("B" & i & ":AH" & i)
'jos summakaavan tulos=0 oletetaan , että rivi on tyhjä ja ei kirjoiteta tiedostoon? hipsaa allaolevat jos haluat kirjoittaa tyhjät riit tiedostoon
If Not Range("AI" & i) = 0 Then
.Write (Solu.Value & ";")
End If
Next
.Write (vbNewLine)
Next
End With
End Sub


Sub HaeTiedot()
Dim a
Dim vika As Long
Dim i As Long
On Error GoTo virhe
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'muuta polku ja tiedostonnimi sopivaksi
With CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\Temp\Koe1.txt")
Do While Not .AtEndOfStream
If .Line = 1 Then
a = Split(.ReadLine, ";")
Range("AH2") = a(0)
Range("AI2") = a(1)
Else
If .Line = 2 Then
a = Split(.ReadLine, ";")
Range("C3") = a(0)
Range("G3") = a(1)
Range("H3") = a(2)
Range("I3") = a(3)
Range("AI3") = a(4)
Else
Cells(.Line 3, 2).Value = .ReadLine
End If
End If
Loop
.Close
End With
vika = Range("B65536").End(xlUp).Row
Range("B7:B" & vika).TextToColumns Destination:=Range("B7"), DataType:=xlDelimited, Other:=True, OtherChar:=";", FieldInfo:=Array(1, 1)
Range("AI7:AI" & vika).FormulaR1C1 = "=SUM(RC[-31]:RC[-1])"
' jos kirjoitetaan tiedostoon tyhjiä rivejä ja sitten luetaan ne Exceliin ja halutaan poistaa tyhjät rivit summa=0 niin hipsaa allaolevat rivit
' For i = vika To 7 Step -1
' If Range("AI" & i) = 0 Then
' Range("AI" & i).EntireRow.Delete
' End If
' Next
virhe:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Keep EXCELing
@Kunde

No niin. Sanoisinko KIITTI oikein isoilla. Laitoin uuteen testiin kolme nappii, johon noi kaks sun ja tyhjennyksen kolmanteen ja JEEEEE. Täytyy häpeillä vähän ensin ja sitten siirtää omaan viritykseen. Tulipahan taas muistutus. Tarkasta äläkä kattele.

Moikka taas

Tässä pätkä tektitiedostosta, jota pitäs vähän fiksaa. Tuli pikku muutos tehtyy. Vieläks jeesaat

22;1.6.2015
Ryhmä A;R28;30;35;Kesä
Nimi1;synt.aika;x;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
...
Nimi8;synt.aika;x;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
[Nimi1];;x;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
[Nimi2];;x;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Muutostarve olis, et kun tulee hakasulkeissa oleva vastaan, niin siitä eteenpäin tulostettas Range("B" & vika1 1) alkaen.
(Laitoin itelle noin hakasulkeet, yritin tunnistaa niistä, mut enpä onnistunu. Saa ne ottaa poiskin tarvittaessa).

Nimi1 tulostetaan B7
...
Nimi8 tulostetaan B14
[Nimi1] tulostetaan Range("B" & vika1 1)
...


Tällä homma hoidettiin B7 alkaen yhteen putkeen, mutta nyt pitäs tota loppuosaa muuttaa

With CreateObject("Scripting.FileSystemObject").OpenTextFile(Polku)
Do While Not .AtEndOfStream
If .Line = 1 Then
a = Split(.ReadLine, ";")
Range("AH2") = a(0)
Range("AI2") = a(1)
Else
If .Line = 2 Then
a = Split(.ReadLine, ";")
Range("C3") = a(0)
Range("G3") = a(1)
Range("H3") = a(2)
Range("I3") = a(3)
Range("AI3") = a(4)
Else
Cells(.Line 3, 2).Value = .ReadLine
End If
End If
Loop
.Close
End With

vika = Range("B65536").End(xlUp).Row
Range("B7:B" & vika).TextToColumns Destination:=Range("B7"), DataType:=xlDelimited, Other:=True, OtherChar:=";", FieldInfo:=Array(1, 1)
Range("AI7:AI" & vika).FormulaR1C1 = "=SUM(RC[-31]:RC[-1])"

Muutostarve olis, et kun tulee hakasulkeissa oleva vastaan, niin siitä eteenpäin tulostettas Range("B" & vika1 1) alkaen.
(Laitoin itelle noin hakasulkeet, yritin tunnistaa niistä, mut enpä onnistunu. Saa ne ottaa poiskin tarvittaessa).
Nimi1 tulostetaan B7
...
Nimi8 tulostetaan B14
[Nimi1] tulostetaan Range("B" & vika1 1)

mistäs toi vika1 saadaan?
ja jos eka hakasulku tulee vastaan niin onko kaikki sen jälkeen sit vika1 juttuja?

Se on tosta muutosvaiheesta yks jäänne. Hassusti jääny, että haetaan tohon muuttujaan eikä käytetä suoraan AF3 paikkaa. Tos AF3 solus on listojen pituuksista johtuen aina ton ekan "hakasulkeen" tulostuskohta. Juu se on raja, jonka jälkeen tulostuskohta siirtyy

Jos AF3 aletaan niin silloinhan siinä kirjoitetaan AI3 päälle ja toiseksi ilman hakasulkua olevien rivien pääle kanssa kirjoitetaan loppupäässä...
Ei nyt sulla täsmää nää antamasi ohjetiedot...

Kunde

Auts. Näinkös huonosti mä saan ajatukset tuotuu esille. Nyt täytyy yrittää. Tosta AF3 haetaan sen rivin numero (tässä Ryhmä A tapauksessa se on 31), mistä tulostus jatkuu (B31), kun tiedoston luvussa on edetty hakasulkeisiin asti.

ub HaeTiedot()
Dim a
Dim vika As Long
Dim i As Long
Dim Rivi As String
On Error GoTo virhe
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'muuta polku ja tiedostonnimi sopivaksi
Set tiedosto = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\Temp\Koe1.txt")
With tiedosto
Do While Not .AtEndOfStream
If .Line = 1 Then
a = Split(.readline, ";")
Range("AH2") = a(0)
Range("AI2") = a(1)
Else
If .Line = 2 Then
a = Split(.readline, ";")
Range("C3") = a(0)
Range("G3") = a(1)
Range("H3") = a(2)
Range("I3") = a(3)
Range("AI3") = a(4)
Else
Rivi = .readline
If Left(Rivi, 1) = "[" Then
If Range("B" & Range("AF3")) = "" Then
Range("B" & Range("AF3")) = Rivi
Range("B" & Range("AF3")) = Replace(Range("B" & Range("AH3")), "[", "")
Range("B" & Range("AF3")) = Replace(Range("B" & Range("AH3")), "]", "")
Else
Range("B35565").End(xlUp).Offset(1, 0) = Rivi
Range("B35565").End(xlUp) = Replace(Range("B35565").End(xlUp), "[", "")
Range("B35565").End(xlUp) = Replace(Range("B35565").End(xlUp), "]", "")
End If
Else
Cells(.Line 3, 2).Value = Rivi
End If
End If
End If
Loop
.Close
End With
vika = Range("B65565").End(xlUp).Row
Range("B7:B" & vika).TextToColumns Destination:=Range("B7"), DataType:=xlDelimited, Other:=True, OtherChar:=";", FieldInfo:=Array(1, 1)
vika = Range("B" & Range("AH3")).End(xlUp).Row
Range("AI7:AI" & vika).FormulaR1C1 = "=SUM(RC[-31]:RC[-1])"

vika = Range("B65565").End(xlUp).Row
Range("AI" & Range("AH3") & ":AI" & vika).FormulaR1C1 = "=SUM(RC[-31]:RC[-1])"
' jos kirjoitetaan tiedostoon tyhjiä rivejä ja sitten luetaan ne Exceliin ja halutaan poistaa tyhjät rivit summa=0 niin hipsaa allaolevat rivit
' For i = vika To 7 Step -1
' If Range("AI" & i) = 0 Then
' Range("AI" & i).EntireRow.Delete
' End If
' Next
virhe:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Keep EXCELing
@Kunde

Moikka

Viel olis pari harmillista kohtaa.

Tiedoston useiden lataus/tallennus -tapahtumien johdosta olis hyvä olla hakasulkeet takas tallennettaessa. Nyt korvannu ton, ottamalla niiden poiston pois käytöstä.

Toisena murheena on että kun toi summasarake kopsataan takas, niin saiskos siihen et jos tulos on nolla, niin se näyttäs tyhjän solun.

Sub Kirjoittaa()
Dim vika As Long
Dim vika2 As Long
Dim Solu As Range
Dim i As Long

vika = Range("B" & Range("AH3")).End(xlUp).Row
'muuta polku ja tiedostonnimi sopivaksi
With CreateObject("Scripting.FileSystemObject").CreateTextFile("C:\Temp\Koe1.txt")
.Write (Range("AH2").Value & ";" & Range("AI2").Value)
.Write (vbNewLine)
.Write (Range("C3").Value & ";" & Range("G3").Value & ";" & Range("H3").Value & ";" & Range("I3").Value & ";" & Range("AI3").Value)
.Write (vbNewLine)
For i = 7 To vika
For Each Solu In Range("B" & i & ":AH" & i)
'jos summakaavan tulos=0 oletetaan , että rivi on tyhjä ja ei kirjoiteta tiedostoon? hipsaa allaolevat jos haluat kirjoittaa tyhjät riit tiedostoon
If Not Range("AI" & i) = 0 Then
.Write (Solu.Value & ";")
End If
Next
.Write (vbNewLine)
Next
vika2 = Range("B65536").End(xlUp).Row
For i = Range("AH3") To vika2
For Each Solu In Range("B" & i & ":AH" & i)
'jos summakaavan tulos=0 oletetaan , että rivi on tyhjä ja ei kirjoiteta tiedostoon? hipsaa allaolevat jos haluat kirjoittaa tyhjät riit tiedostoon
If Not Range("AI" & i) = 0 Then
If Solu.Address = "$B" & "$" & i Then
.Write ("[" & Solu.Value & "]" & ";")
Else
.Write (Solu.Value & ";")
End If
End If
Next
.Write (vbNewLine)
Next
End With
End Sub
Sub HaeTiedot()
Dim a
Dim vika As Long
Dim i As Long
Dim Rivi As String
On Error GoTo virhe
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'muuta polku ja tiedostonnimi sopivaksi
Set tiedosto = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\Temp\Koe1.txt")
With tiedosto
Do While Not .AtEndOfStream
If .Line = 1 Then
a = Split(.readline, ";")
Range("AH2") = a(0)
Range("AI2") = a(1)
Else
If .Line = 2 Then
a = Split(.readline, ";")
Range("C3") = a(0)
Range("G3") = a(1)
Range("H3") = a(2)
Range("I3") = a(3)
Range("AI3") = a(4)
Else
Rivi = .readline
If Left(Rivi, 1) = "[" Then
If Range("B" & Range("AH3")) = "" Then
Range("B" & Range("AH3")) = Rivi
Range("B" & Range("AH3")) = Replace(Range("B" & Range("AH3")), "[", "")
Range("B" & Range("AH3")) = Replace(Range("B" & Range("AH3")), "]", "")
Else
Range("B35565").End(xlUp).Offset(1, 0) = Rivi
Range("B35565").End(xlUp) = Replace(Range("B35565").End(xlUp), "[", "")
Range("B35565").End(xlUp) = Replace(Range("B35565").End(xlUp), "]", "")
End If
Else
Cells(.Line 3, 2).Value = Rivi
End If
End If
End If
Loop
.Close
End With
vika = Range("B" & Range("AH3")).End(xlUp).Row
Range("B7:B" & vika).TextToColumns Destination:=Range("B7"), DataType:=xlDelimited, Other:=True, OtherChar:=";", FieldInfo:=Array(1, 1)
Range("AI7:AI" & vika).FormulaR1C1 = "=IF(SUM(RC[-31]:RC[-1])=0,"""",SUM(RC[-31]:RC[-1]))"

vika2 = Range("B65565").End(xlUp).Row
Range("B" & Range("AH3") & ":B" & vika2).TextToColumns Destination:=Range("B" & Range("AH3")), DataType:=xlDelimited, Other:=True, OtherChar:=";", FieldInfo:=Array(1, 1)
Range("AI" & Range("AH3") & ":AI" & vika2).FormulaR1C1 = "=IF(SUM(RC[-31]:RC[-1])=0,"""",SUM(RC[-31]:RC[-1]))"
' jos kirjoitetaan tiedostoon tyhjiä rivejä ja sitten luetaan ne Exceliin ja halutaan poistaa tyhjät rivit summa=0 niin hipsaa allaolevat rivit
' For i = vika To 7 Step -1
' If Range("AI" & i) = 0 Then
' Range("AI" & i).EntireRow.Delete
' End If
' Next
virhe:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Keep EXCELing
@Kunde

Moi taasen

Eipä ne murheet viel loppuneet (kehitys jatkuu, kun vaan osais). Sain tallennettuu kyl, mutta luettaessa ei sit menny sarakkeisiinsa ollenkaan. Miten ois rivin lisäys. Tartteisin D4:AH4 alueen tallennuksen ja lukemisen tohon tiedostohommaan, joka toimii uskomattoman nopeesti vanhaan verrattuna. Kiitoksen paikka.