Sub HavislistaV()
' Ohjelma muodostaa Virtalan Hyönteistietokannan Standard-syöttötiedoston tauluun "Vuosi".
' Alkuperäinen data poimitaan kaikista muun nimisistä tauluista, joissa on riveillä lajit ja sarakkeilla päivämäärät.
' Suku on 1. sarakkeella ja laji on 2. sarakkeella alkaen riviltä "DataAlkuRivi".
' Alkupäivämäärät ovat rivillä "AlkuAikaRivi" alkaen sarakkeelta 3.
' Loppupäivämäärät ovat vastaavasti rivillä "LoppuAikaRivi" alkaen sarakkeelta 3.
' Päivämäärät em. rivien soluissa on oltava Excelin Date-formaatissa, esim. 2009-02-27 tai 27.2.2009.

' Joka havainnolle generoidaan uniikki koodi, jonka avulla tietoja voi myöhemmin päivittää tietokannassa.
' Se on muotoa I:C:FTRS, missä I="SPS", C=kerääjän 4-merkin pituinen kokoelmakoodi (RUBIN-koodi), F=tiedoston nimen 3 ensimmäistä merkkiä, T=taulun (worksheet) 2 ensimmäistä merkkiä, R=rivikoodi, S=sarakenumero.
' Sen vuoksi tiedostot kannattaa nimetä niin, että 3 ensimmäistä merkkiä ovat muuttumattomia ja uniikkeja.

' (c) Hannu Saarenmaa, Luonnontieteellinen keskusmuseo, 2009-02-26. hannu.saarenmaa@helsinki.fi.  Released under Mozilla Public Licence.
' Ohjeita http://havainnot.lepidoptera.fi/excel-pulautin.php
  
' Seuraavia parametrejä voi muuttaa vastaamaan syöttötiedostoa.
  
  CollectionCode = "XXXX"  ' Seuran luetteloima ilmoittajan 4-merkkinen kokoelmakoodi
  
  MaxSarake = 40
  AlkuAikaRivi = 2
  LoppuAikaRivi = 2
  
  DataAlkuRivi = 3
  MaxRivi = 500
  
  MaakuntaRivi = 1
  MaakuntaSarake = 3
  KuntaRivi = 1
  KuntaSarake = 4
  PaikkaRivi = 1
  PaikkaSarake = 5
  KoordiRivi = 1
  KoordiSarake = 6
  HabitaattiRivi = 1
  HabitaattiSarake = 9
  MenetelmäRivi = 1
  MenetelmäSarake = 10
  KerääjäRivi = 1
  KerääjäSarake = 14
  MäärittäjäRivi = 1
  MäärittäjäSarake = 14
  HuomautusRivi = 1
  HuomautusSarake = 16
  PiilotaTarkatTiedotRivi = 1
  PiilotaTarkatTiedotSarake = 20
  PiilotaKoordRivi = 1
  PiilotaKoordSarake = 21
  PiilotaKeraajaRivi = 1
  PiilotaKeraajaSarake = 22
  
' Tästä eteenpäin ei kannata muuttaa koodia.
  
  InstitutionCode = "SPS"  ' Suomen Perhostutkijain Seuran koodi luettelossa http://hbs.bishopmuseum.org/codens/
  Tiedosto = Left$(ThisWorkbook.Name, 3) ' Tiedoston nimen 3 ensimmäistä merkkiä
  
' Luodaan taulu "Vuosi", mutta ensin tuhotaan vanha jos on.

Application.DisplayAlerts = False
On Error Resume Next
Sheets("Vuosi").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Dim MyNewSheet As Worksheet
Set MyNewSheet = Sheets.Add
MyNewSheet.Name = "Vuosi"
 
'  Aloitetaan taulujen kelaaminen
 
  Dim Taulu As Worksheet
   
   N = 0
    For Each Taulu In Worksheets
        If Taulu.Name <> "Vuosi" Then
        MsgBox ("Siirrytään tauluun " + Taulu.Name + ". " + Str(N) + " havaintoa valmiina.")
    
      For rivi = DataAlkuRivi To MaxRivi
        If Taulu.Cells(rivi, 1) = "" Then Exit For
        
        For Sarake = 3 To MaxSarake
            If Taulu.Cells(rivi, Sarake) <> 0 Then
                N = N + 1
                If N > 65000 Then Exit For
                Worksheets("Vuosi").Cells(N, 1) = InstitutionCode & ":" & CollectionCode & ":" & Tiedosto & Left(Taulu.Name, 2) & Replace(Taulu.Cells(rivi, Sarake).Address, "$", "")
                Worksheets("Vuosi").Cells(N, 2) = Taulu.Cells(rivi, 1) & " " & Taulu.Cells(rivi, 2)
                Kauttaviiva = InStr(Taulu.Cells(rivi, Sarake), "/")   'Jos ilmoitettu koirasLkm/naarasLkm tai pelkkä lajin esiintyminen ilman lukumäärää.
                If Kauttaviiva > 0 Then
'                    MsgBox ("Kautta" & Taulu.Cells(rivi, Sarake))
                    Worksheets("Vuosi").Cells(N, 3) = Left(Taulu.Cells(rivi, Sarake), Kauttaviiva - 1)
                    Worksheets("Vuosi").Cells(N, 4) = Mid(Taulu.Cells(rivi, Sarake), Kauttaviiva + 1)
                Else                                                  'Jos ilmoitettu vain yksi Lkm.
                    Worksheets("Vuosi").Cells(N, 5) = Taulu.Cells(rivi, Sarake)
                End If
                Worksheets("Vuosi").Cells(N, 6) = "Aikuinen"
                Worksheets("Vuosi").Cells(N, 7) = Taulu.Cells(MaakuntaRivi, MaakuntaSarake)
                Worksheets("Vuosi").Cells(N, 8) = Taulu.Cells(KuntaRivi, KuntaSarake)
                Worksheets("Vuosi").Cells(N, 9) = Taulu.Cells(PaikkaRivi, PaikkaSarake)
                Worksheets("Vuosi").Cells(N, 10) = Taulu.Cells(KoordiRivi, KoordiSarake)
                Worksheets("Vuosi").Cells(N, 11) = Format(Taulu.Cells(AlkuAikaRivi, Sarake), "DD")
                Worksheets("Vuosi").Cells(N, 12) = Format(Taulu.Cells(AlkuAikaRivi, Sarake), "MM")
                Worksheets("Vuosi").Cells(N, 13) = Format(Taulu.Cells(LoppuAikaRivi, Sarake), "DD")
                Worksheets("Vuosi").Cells(N, 14) = Format(Taulu.Cells(LoppuAikaRivi, Sarake), "MM")
                Worksheets("Vuosi").Cells(N, 15) = Format(Taulu.Cells(AlkuAikaRivi, Sarake), "YYYY")
                Worksheets("Vuosi").Cells(N, 16) = Taulu.Cells(HabitaattiRivi, HabitaattiSarake)
                Worksheets("Vuosi").Cells(N, 17) = Taulu.Cells(MenetelmäRivi, MenetelmäSarake)
                Worksheets("Vuosi").Cells(N, 18) = Taulu.Cells(KerääjäRivi, KerääjäSarake)
                Worksheets("Vuosi").Cells(N, 19) = Taulu.Cells(MäärittäjäRivi, MäärittäjäSarake)
                Worksheets("Vuosi").Cells(N, 20) = Format(Taulu.Cells(LoppuAikaRivi, Sarake), "YYYY")
                Worksheets("Vuosi").Cells(N, 21) = "Lab.määritys"
                Worksheets("Vuosi").Cells(N, 22) = Taulu.Cells(HuomautusRivi, HuomautusSarake)
                Worksheets("Vuosi").Cells(N, 23) = Taulu.Cells(PiilotaTarkatTiedotRivi, PiilotaTarkatTiedotSarake)
                Worksheets("Vuosi").Cells(N, 24) = Taulu.Cells(PiilotaKoordRivi, PiilotaKoordSarake)
                Worksheets("Vuosi").Cells(N, 25) = Taulu.Cells(PiilotaKeraajaRivi, PiilotaKeraajaSarake)
 ' Mahdollinen piilotus merkitään *-llä, mutta laitetaan nämä dummy-selitykset, jotta saadaan syöttötiedostoon tarpeellinen määrä kenttiä.
                If Worksheets("Vuosi").Cells(N, 23) <> "*" Then Worksheets("Vuosi").Cells(N, 23) = "eipiilTT"
                If Worksheets("Vuosi").Cells(N, 24) <> "*" Then Worksheets("Vuosi").Cells(N, 24) = "eipiilKoo"
                If Worksheets("Vuosi").Cells(N, 25) <> "*" Then Worksheets("Vuosi").Cells(N, 25) = "eipiilKer"

            Else
'                MsgBox ("E" & Taulu.Cells(rivi, Sarake))
            End If
        Next Sarake
     Next rivi
   
    End If
    Next Taulu
    MsgBox ("Valmista tuli!  Kirjoitettu " + Str(N) + " havaintoa tauluun Vuosi.  Ohjelman suoritus päättyy.")
   
   End Sub