Option Explicit
Dim A(2, 60) As Integer
Dim KerroinRivi As Integer
Dim KisaCol1 As Integer, KisaCol2 As Integer, KisaLkm As Integer
Dim OpenCol1 As Integer, OpenCol2 As Integer, OpenLkm As Integer
Dim UlkoCol1 As Integer, UlkoCol2 As Integer, UlkoLkm As Integer

Dim SummaCol As Integer

Function pvnro(kisa As String, i As Integer) As Variant
  Dim cell As Variant
  Set cell = Worksheets(kisa).Cells(3, 3 + i)
  pvnro = cell
End Function

Function tulos(kisa As String, pv As Integer, nimi As String) As Variant
' Hakee kilpailijan nimi tuloksen sivulta kisa sarakkeesta pv
  Dim r As Range
  Dim i As Integer
  Set r = Worksheets(kisa).Range("C4:C20")
'  tulos = Application.VLookup(nimi, r, i, 0)
'  tulos = Application.Sum(r)
  For i = 1 To 60
    If (IsEmpty(r.Cells(i, 1))) Then
      tulos = ""
      Exit Function
    End If
    If (r.Cells(i, 1) = nimi) Then
      If (IsEmpty(r.Cells(i, 1 + pv))) Then tulos = "" Else tulos = r.Cells(i, 1 + pv)
      Exit Function
    End If
  Next
  tulos = Empty
End Function


Function lajittele(aloitus As Integer, lkm As Integer) As Integer
' Lajittelee 2-ulotteisen taulukon A siten että suurin on alussa
' lajitellaan väli [aloitus,aloitus+lkm-1]
  Dim s As Integer, si As Integer, i As Integer, alku As Integer, t As Integer, n As Integer
  n = aloitus + lkm - 1
  For alku = aloitus To n
    s = A(1, alku)
    si = alku
    For i = alku + 1 To n ' etsitään suurin paikasta alku alkaen
      If A(1, i) > s Then
        s = A(1, i)
        si = i
      End If
    Next i
    ' Vaihdetaan suurin paikkaan alku
    t = A(1, alku): A(1, alku) = A(1, si): A(1, si) = t
    t = A(2, alku): A(2, alku) = A(2, si): A(2, si) = t
  Next alku
  lajittele = 0
End Function

Function summaa(lkm As Integer)
' Laskee summan taulukon A 1-sarakkeesta lkm ensimmäisestä alkiosta
  Dim s As Integer, i As Integer
  s = 0
  For i = 1 To lkm
    If (A(1, i) > 0) Then s = s + A(1, i)
  Next
  summaa = s
End Function


Function jatka_indeksi(f As Variant, r As Variant, paikka As Integer)
' Jatkaa indeksitaulukkoa A kerroinirivi f, rivi r yhdistelmällä
  Dim i As Integer
  Dim fa As Double
'  Set A = r
  Dim ai As Integer
  ai = paikka
  For i = 1 To r.Count
    fa = 1
    If Not IsEmpty(f(1, i)) And IsNumeric(f(1, i)) Then fa = f(1, i)
    If Not IsEmpty(r(1, i)) And IsNumeric(r(1, i)) And fa > 0 Then A(1, ai) = fa * r(1, i) Else A(1, ai) = -1
    A(2, ai) = r(1, i).Column
    ai = ai + 1
  Next
  jatka_indeksi = 0
End Function

Function tayta_indeksi(f As Variant, r As Variant)
  tayta_indeksi = jatka_indeksi(f, r, 1)
End Function

'Function parhaat(f As Variant, r As Variant, lkm As Integer) As Integer
'  Dim i As Integer
'  KisaCol1 = r.Column
'  KisaCol2 = KisaCol1 + r.Count - 1
'  KerroinRivi = f.row
'  KisaLkm = lkm
'  i = tayta_indeksi(f, r)
'  lajittele (r.Count)
'  parhaat = summaa(lkm)
'End Function

Sub maalaa_ja_laske_summa(row As Integer)
' Maalaa tietyn rivin tulokset ja laskee summan.
' Käyttää globaaleja muuttujia:
' KisaCol?, KisaLkm, OPenCol?, OpenLkm, UlkoCol?, UlkoLkm
' Parametrin välityksenä seuraaviin globaali indeksitaulukko A
  Dim i As Integer
  Dim rKisa As Variant, rKisaKerroin As Variant
  Dim rOpen As Variant, rOpenKerroin As Variant
  Dim rUlko As Variant, rUlkoKerroin As Variant
  Dim rRow As Variant
  Dim sum As Double
  Set rKisa = Worksheets("Ranking").Range(Cells(row, KisaCol1), Cells(row, KisaCol2))          ' Rivi
  Set rKisaKerroin = Worksheets("Ranking").Range(Cells(KerroinRivi, KisaCol1), Cells(KerroinRivi, KisaCol2)) ' Kerroinrivi
  Set rOpen = Worksheets("Ranking").Range(Cells(row, OpenCol1), Cells(row, OpenCol2))   ' Rivi
  Set rOpenKerroin = Worksheets("Ranking").Range(Cells(KerroinRivi, OpenCol1), Cells(KerroinRivi, OpenCol2)) ' Kerroinrivi
  Set rUlko = Worksheets("Ranking").Range(Cells(row, UlkoCol1), Cells(row, UlkoCol2))   ' Rivi
  Set rUlkoKerroin = Worksheets("Ranking").Range(Cells(KerroinRivi, UlkoCol1), Cells(KerroinRivi, UlkoCol2)) ' Kerroinrivi
  Set rRow = Worksheets("Ranking").Range(Cells(row, 1), Cells(row, 200))
  
  i = tayta_indeksi(rOpenKerroin, rOpen) ' Globaaliin taulukkoon A Openin tulokset
  i = lajittele(1, rOpen.Count)
  
  i = jatka_indeksi(rUlkoKerroin, rUlko, 1 + OpenLkm)
  i = lajittele(1 + OpenLkm, rUlko.Count)
  
  i = jatka_indeksi(rKisaKerroin, rKisa, 1 + OpenLkm + UlkoLkm)
  i = lajittele(1, rKisa.Count + OpenLkm + UlkoLkm)
  
  rKisa.Font.Bold = False
  rKisa.Font.Size = 6
  rOpen.Font.Bold = False
  rOpen.Font.Size = 6
  rUlko.Font.Bold = False
  rUlko.Font.Size = 6
  
  sum = 0
  
  For i = 1 To KisaLkm
'    r(1, A(2, i)).Font.bold = True
    If A(1, i) >= 0 Then rRow(1, A(2, i)).Font.Size = 10: sum = sum + A(1, i)
  Next i
  rRow(1, SummaCol).Value = sum
End Sub

Sub maalaa_kaikki_ja_laske_summat(kisa As String, openr As String, sumname As String, ulkom As String)
' Maalaa valitun alueen tulokset isoksi tai pieniksi ja laskee summan
' kisa     = varsinaisen kisan alue (otsikkorivissä)
' openr    = matkaopenin alue
' sumname  = tulosken nimi
' ulkom    = ulkomaisten kisojen alue

  Dim row As Integer
  Dim r As Variant
  KisaCol1 = Range(kisa).Column: KisaCol2 = KisaCol1 + Range(kisa).Count - 1:    KisaLkm = 10
  OpenCol1 = Range(openr).Column: OpenCol2 = OpenCol1 + Range(openr).Count - 1:   OpenLkm = 2
  UlkoCol1 = Range(ulkom).Column:  UlkoCol2 = UlkoCol1 + Range(ulkom).Count - 1:   UlkoLkm = 3
  SummaCol = Range(sumname).Column
  KerroinRivi = 2
  
  For row = 6 To 80
    Set r = Worksheets("Ranking").Range(Cells(row, 1), Cells(row, 1))
    If (IsEmpty(r)) Then Exit Sub
    maalaa_ja_laske_summa row
  Next
End Sub

'Sub maalaa_kaikki_94()
'  maalaa_kaikki_ja_laske_summat "Kisa94", "open94r", "sum94"
'End Sub'
'
'Sub maalaa_kaikki_95()
'  maalaa_kaikki_ja_laske_summat "Kisa95", "open95r", "sum95"
'End Sub

Sub maalaa_kaikki_96()
  maalaa_kaikki_ja_laske_summat "Kisa96", "open96r", "sum96", "ulko96"
End Sub

'
' Jarjesta Macro
' Jarjestaa aineiston nimikenttää seuraavan kentän mukaan (Offset(0,1))
'
'
Sub Jarjesta()
    Application.GoTo Reference:="data"
    Selection.Sort Key1:=ActiveCell.Offset(0, 1).Range("A1"), Order1:= _
        xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
         Orientation:=xlTopToBottom
End Sub

'
' TalletaTeksti Macro
' Macro recorded 20.5.1995 by vl
'
'
Sub TalletaTeksti()
    Dim filename As String
    filename = "ran98.prn"
    Range("A1:G71").Select
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    
    ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 5
    ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.ColumnWidth = 19
    ActiveCell.Offset(0, 2).Columns("A:A").EntireColumn.ColumnWidth = 6.14
    ActiveCell.Offset(0, 3).Columns("A:A").EntireColumn.ColumnWidth = 0.14
    ActiveCell.Offset(0, 4).Columns("A:A").EntireColumn.ColumnWidth = 6.14
    ActiveCell.Offset(0, 5).Columns("A:A").EntireColumn.ColumnWidth = 6.14
    ActiveCell.Offset(0, 6).Columns("A:A").EntireColumn.ColumnWidth = 6.14
    ActiveCell.Columns("A:A").EntireColumn.Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "0\. "
    ActiveCell.Columns("B:G").EntireColumn.Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "0 "
    Range("B2:B2").Select
    Selection.NumberFormat = "d.m.yyyy"
  
'    ChDir "E:\RIIPPU\RKT\RANKING\96"
    On Error Resume Next
    Kill (filename)
    On Error GoTo 0
    ActiveWorkbook.SaveAs filename:=filename, FileFormat:= _
        xlTextPrinter, CreateBackup:=True
    ActiveWorkbook.Close (False)
'    Shell ("h.bat")
End Sub

'
' OtaTulokset Macro
' Macro recorded 20.5.1995 by vl
'
'

Sub LueOpen() ' Lukee levyltä kilpailun
    Dim filename As String
    Dim r As Variant
    Dim class As String
    Dim startrow As Integer
    class = Range("a2")
    startrow = Range("b2")
    If startrow = 0 Then startrow = 5
  
    filename = InputBox(Title:="Ranking", Prompt:="Luettava tiedosto", default:=ActiveSheet.Name & ".TXT")
    If filename = "" Then GoTo loppu
    
    Set r = Range("a3").Cells(1, 1)
    Range("A3:M200").Select
    Selection.Copy
    
    If class = "open" Then
      Workbooks.OpenText filename:=filename, _
        Origin:=xlMSDOS, startrow:=startrow, DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(4, 1), Array(8, 1), Array(28, 4), _
        Array(40, 1), Array(46, 1), Array(50, 1), Array(56, 1), Array(63, 1), Array(69 _
        , 1), Array(76, 1))
    ElseIf class = "sum" Then
      Workbooks.OpenText filename:=filename, _
        Origin:=xlMSDOS, startrow:=startrow, DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(4, 1), Array(8, 1), Array(28, 1), _
        Array(33, 1), Array(40, 1), Array(47, 1))
    Else
      Workbooks.OpenText filename:=filename, _
        Origin:=xlMSDOS, startrow:=startrow, DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(3, 1), Array(7, 1), Array(30, 1), _
        Array(35, 1), Array(40, 1), Array(45, 1), Array(50, 1), Array(55, 1), _
        Array(60, 1), Array(65, 1))
    End If

    
    
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    
    Range("A1:M200").Select
    Selection.Copy (r)
    ActiveWindow.Close (False)
    Rows("4:4").Select
    Selection.Delete Shift:=xlUp
loppu:
    
End Sub