Attribute VB_Name = "Module1"
'JATKOKEHITETTÄVÄÄ: 
'Päivämäärä tallentuu tässä esimerkissä C-sarakkeelle merkkijonomuodossa. 
'Jos näet tarpeelliseksi, konvertoi päivämäärä Windows-päivämääräksi käyttämällä merkkijono- ja päivämääräfunktioita. 
'Tarvitset todennäköisesti ainakin Mid-merkkijonofunktiota ja DateSerial-päivämääräfunktiota. 
'Ota tarvittaessa mallia luvusta 4.

Private Function SiirtoTstoTarkistus() As String
'Rivillä 2 luetaan siirtotiedoston sijainti työkirjan Asetukset-sivulta.
'Rivillä 3 testataan tiedoston statusta Dir-funktion avulla.
'SiirtoTstoTarkistus-aliohjelma on klassinen esimerkki sellaisesta funktiosta,
'  jossa haluaa asettaa virheensieppauksen päälle ihan vaan "varmuuden vuoksi".
'Varsinkin jos siirtotiedostoa luetaan verkkolevyltä,
'  tiedoston olemassaolon tarkistuksen aikana verkossa voi tapahtua mitä tahansa.
  Dim TmpS As String
On Error GoTo Virhe:
  TmpS = Sheets("Asetukset").Range("B1").Value
  If Dir(TmpS) = "" Then TmpS = "N/A"
  SiirtoTstoTarkistus = TmpS
  Exit Function
Virhe:
  SiirtoTstoTarkistus = "N/A"
End Function

Private Function EkaTyhjaRivi_CurrentRegionRatkaisu() As Long
'Tämä toimii kuten alla EkaTyhjaRivi-funktio, mutta tämä ratkaisu käyttää solun CurrentRegion-ominaisuutta vastauksen saamiseksi.
  EkaTyhjaRivi_CurrentRegionRatkaisu = CLng(Mid(Range("A4").CurrentRegion.Address, 9)) + 1
End Function

Private Function EkaTyhjaRivi() As Long
'Funktiossa tehdään oletus,
'  että kun A-sarakkeella tulee vastaan tyhjä solu,
'  ollaan löydetty ensimmäinen tyhjä rivi.
'A-sarakkeen informaatio tulkitaan siten avaintiedoksi.
'Tämä tarkoittaa sitä, että sellaista riviä ei tietokannassa sallita,
'  jossa A-sarakkeen informaatio olisi tyhjä.
'Silmukan ehtolause on rivillä 3.
'Silmukkaa suoritetaan niin kauan kunnes läydetään tyhjä solu A-sarakkeelta.
'Kun silmukkaan mennään sisälle, kasvatetaan rivilaskuria yhdellä.
'Silmukka siis todellakin palauttaa ensimmäisen tyhjän rivin rivinumeron,
'  eikä siis viimeisen täytetyn rivin numeroa.
1  Dim TmpL As Long
2  TmpL = 5
3  Do While Sheets("Data").Range("A" & TmpL).Value <> ""
4    TmpL = TmpL + 1
5  Loop
6  EkaTyhjaRivi = TmpL
End Function

Private Function LaskePilkut(ByVal S As String) As Long
'Koodissa käydään silmukassa läpi merkkijono positio kerrallaan.
'Silmukan ehtolause on rivillä 5.
'Siinä määrätään,
'  että silmukkaa käydään läpi niin kauan kunnes positiolaskurissa Pos on talletettuna arvo,
'  joka on suurempi kuin käsiteltävän merkkijonon pituus.
'Silmukan sisällä on ehtolause rivillä 6.
'Ehtolauseessa tarkistetaan käsiteltävän merkkijonon kyseisessä positiossa oleva merkki ja verrataan sitä pilkkuun.
'Jos merkki on pilkku, kasvatatetaan pilkkulaskuria PLkm yhdellä.
'Rivillä 7 kasvatetaan simukkalaskuria yhdellä jonka jälkeen kontrolli siirtyy takaisin silmukan aloittavaan ehtolauseeseen riville 5.
1  Dim PLkm As Long
2  Dim Pos As Long
3  PLkm = 0
4  Pos = 1
5  Do While Pos <= Len(S)
6    If Mid(S, Pos, 1) = "," Then PLkm = PLkm + 1
7    Pos = Pos + 1
8  Loop
9  LaskePilkut = PLkm
End Function

Private Function SiirraRivit(ByVal F As String) As Long
'Funktio SiirraRivit saa luettavan tiedoston nimen parametrilla F.
'Tämä tiedosto avataan koodin rivillä 8.
'Koska siirtotiedoston ensimmäinen rivi on aina otsikkorivi,
'  se voidaan lukea pois ilman erillisiä tarkistuksia.
'Tämä tehdään koodin rivillä 9.
'Rivin 9 suorituksen jälkeen muuttujassa LRivi on siis tallessa siirtotiedostosta luettu otsikkorivi.
'Muuttujassa ERivi pidetään kirjaa siitä rivistä,
'  johon siirtotiedostosta luettu data kirjoitetaan Excelin taulukkosivulle.
'Sen alkuarvo haetaan rivillä 10 kutsumalla funktiota EkaTyhjaRivi.
'Rivillä 11 on silmukan ehtolause.
'Ehtolauseessa komennetaan suorittamaan niin kauan kunnes siirtotiedoston kaikki rivit on luettu.
'Silmukan lopetusrivi on 23.
'Silmukan sisällä luetaan siirtotiedoston rivi muuttujaan LRivi (rivi 12).
'Sitten tarkistetaan, onko rivi kelvollinen käsiteltäväksi.
'Tämä tehdään rivillä 13 kutsumalla funktiota LaskePilkut.
'Jos funktio palauttaa arvon 3,
'  voidaan siirtyä suorittamaan ehtolauseen sisällä olevat komennot riveillä 14-21.
'Rivillä 14 käytetään valmisfunktiota Split luetun merkkijonon paloitteluun muuttujaan S.
'Muuttuja S on esitelty vektorina (rivi 3),
'  joten siihen voidaan tallentaa tietoa numeroituihin muistipaikkoihin.
'Tässä tapauksessa Split-funktio jakaa merkkijono kunkin pilkun kohdalta muuttujan S muistipaikkoihin.
'Koodin riveillä 15-18 siirtotiedostosta luetut tiedot talletetaan Excelin taulukkosivulle.
'Talletettavan solun sarake on koodissa kiinteä ja rivi saadaan muuttujan ERivi sen hetken arvosta.
'Viittaamalla vektorimuuttujan S muistipaikkoihin asetellaan oikea informaatio oikeille sarakkeille.
'Rivillä 19 kasvatetaan laskuria TmpL.
'Tässä muuttujassa pidetään kirjaa siirrettyjen rivien kappalemäärästä.
'Tämä tieto välitetään myös kutsuvalle aliohjelmalle.
'Rivillä 20 kasvatetaan laskuria Erivi.
'Tätä muuttujan arvoa kasvattamalla seuraava käsiteltävä siirtotiedoston rivi menee siten eri riville kuin edelliset rivit.
'Kun siirtotiedosto on luettu loppuun EOF(1) saa arvokseen True.
'Tällöin silmukan ehtolause Not EOF(1) ei enää toteudu,
'  joten kontrolli siirtyy silmukkalaskurin ulkopuolelle, riville 23.
'Tällä rivillä suljetaan siirtotiedosto ja rivillä 24 asetetaan funktion vastaus.
1   Dim TmpL As Long
2   Dim LRivi As String
3   Dim S() As String
4   Dim ERivi As Long
5   Dim TmpTsto As String
6   TmpL = 0
7   TmpTsto = F
8   Open TmpTsto For Input As #1
9   Line Input #1, LRivi
10  ERivi = EkaTyhjaRivi
11  Do While Not EOF(1)
12    Line Input #1, LRivi
13    If LaskePilkut(LRivi) = 3 Then
14      S = Split(LRivi, ",")
15      Sheets("Data").Range("A" & ERivi).Value = S(0)
16      Sheets("Data").Range("B" & ERivi).Value = S(1)
17      Sheets("Data").Range("C" & ERivi).Value = S(2)
18      Sheets("Data").Range("D" & ERivi).Value = S(3)
19      TmpL = TmpL + 1
20      ERivi = ERivi + 1
21    End If
22  Loop
23  Close #1
24  SiirraRivit = TmpL
End Function

Public Sub SiirtoMain()
1   Dim SiirtoTsto As String
2   Dim SiirrettyOK As Long
3   SiirtoTsto = SiirtoTstoTarkistus
4   If SiirtoTsto = "N/A" Then
5     MsgBox "Siirtotiedostoa ei löydy."
6   Else
7     SiirrettyOK = SiirraRivit(SiirtoTsto)
8     If SiirrettyOK > 0 Then
9       MsgBox "Siirto OK, siirrettyjen rivien kappalemäärä:" & SiirrettyOK
10    Else
11      MsgBox "Siirrossa virhe. Ehkä siirtotiedosto oli tyhjä"
12    End If
13  End If
End Sub