142 lines
5 KiB
Text
142 lines
5 KiB
Text
Option Explicit
|
||
Dim i As Long
|
||
Dim ii As Long
|
||
Dim lastT As Long
|
||
Dim ilmoitus As Long
|
||
Dim firstT As Range
|
||
Dim name As Range
|
||
Dim paikka As Range
|
||
Dim sija As String
|
||
Dim Kunta As String
|
||
Dim stats As String
|
||
Dim Tradi As Long
|
||
Dim Multi As Long
|
||
Dim Webcam As Long
|
||
Dim Mysteeri As Long
|
||
Dim Letterbox As Long
|
||
Dim Earth As Long
|
||
Dim Miitti As Long
|
||
Dim Virtuaali As Long
|
||
Dim CITO As Long
|
||
Dim Wherigo As Long
|
||
Dim Miitti10v As Long
|
||
Dim Mega As Long
|
||
Dim Locationless As Long
|
||
Dim Yht As Long
|
||
Dim found As Integer
|
||
Dim kaikki As Integer
|
||
|
||
Sub Kunnat()
|
||
found = 0
|
||
kaikki = 0
|
||
Set paikka = Worksheets("Tilasto").Columns("A:Z").Find("Paikkakunta")
|
||
Worksheets("Tilasto").Range("T:T").Value = ""
|
||
Worksheets("Tilasto").Range(Cells(paikka.Row - 1, paikka.Column - 1), Cells(paikka.Row - 1, paikka.Column + 1)).Value = ""
|
||
Set firstT = Worksheets("Tilasto").Cells(paikka.Row, paikka.Column).Offset(1, -1)
|
||
Columns(paikka.Column).Replace What:=" ", Replacement:="", LookAt:=xlPart, _
|
||
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
|
||
ReplaceFormat:=False
|
||
lastT = Worksheets("Tilasto").Cells(paikka.Row, paikka.Column).End(xlDown).Row
|
||
|
||
'LOOP
|
||
For i = firstT.Row To lastT
|
||
Worksheets("Tilasto").Cells(paikka.Row - 1, paikka.Column - 1).Value = "Rivi " & i & "/" & lastT
|
||
If Worksheets("Tilasto").Cells(i, paikka.Column - 1).Value <> "Sija" Then
|
||
kaikki = kaikki + 1
|
||
sija = Worksheets("Tilasto").Cells(i, paikka.Column - 1).Value
|
||
Kunta = Worksheets("Tilasto").Cells(i, paikka.Column).Value
|
||
Tradi = Worksheets("Tilasto").Cells(i, paikka.Column + 1).Value
|
||
Multi = Worksheets("Tilasto").Cells(i, paikka.Column + 2).Value
|
||
Webcam = Worksheets("Tilasto").Cells(i, paikka.Column + 3).Value
|
||
Mysteeri = Worksheets("Tilasto").Cells(i, paikka.Column + 4).Value
|
||
Letterbox = Worksheets("Tilasto").Cells(i, paikka.Column + 5).Value
|
||
Earth = Worksheets("Tilasto").Cells(i, paikka.Column + 6).Value
|
||
Miitti = Worksheets("Tilasto").Cells(i, paikka.Column + 7).Value
|
||
Virtuaali = Worksheets("Tilasto").Cells(i, paikka.Column + 8).Value
|
||
CITO = Worksheets("Tilasto").Cells(i, paikka.Column + 9).Value
|
||
Wherigo = Worksheets("Tilasto").Cells(i, paikka.Column + 10).Value
|
||
Miitti10v = Worksheets("Tilasto").Cells(i, paikka.Column + 11).Value
|
||
Mega = Worksheets("Tilasto").Cells(i, paikka.Column + 12).Value
|
||
Locationless = Worksheets("Tilasto").Cells(i, paikka.Column + 13).Value
|
||
Yht = Worksheets("Tilasto").Cells(i, paikka.Column + 14).Value
|
||
|
||
Call tilastot
|
||
|
||
Set name = Worksheets("Kuntarajat").Range("D:D").Find("<name>" & Kunta & "</name>")
|
||
If Not name Is Nothing Then
|
||
If Yht > 0 Then
|
||
Worksheets("Kuntarajat").Cells(name.Row + 2, 4).Value = "<styleUrl>#poly-009D57-1-0</styleUrl>"
|
||
found = found + 1
|
||
Else
|
||
Worksheets("Kuntarajat").Cells(name.Row + 2, 4).Value = "<styleUrl>#poly-DB4436-1-64</styleUrl>"
|
||
End If
|
||
Worksheets("Kuntarajat").Cells(name.Row + 1, 4).Value = "<description><![CDATA[" & stats & "]]></description>"
|
||
Else
|
||
ilmoitus = Worksheets("Tilasto").Range("T" & Rows.Count).End(xlUp).Row + 1
|
||
Worksheets("Tilasto").Cells(ilmoitus, 20).Value = i & " Kunnalle " & Kunta & " ei ole määritetty rajoja"
|
||
End If
|
||
|
||
End If
|
||
Next i
|
||
ilmoitus = Worksheets("Tilasto").Range("T" & Rows.Count).End(xlUp).Row + 1
|
||
Worksheets("Tilasto").Cells(paikka.Row - 1, paikka.Column + 1).Value = "Valmis! Löydetty " & found & "/" & kaikki & " =" & Round(found / kaikki * 100, 2) & "%"
|
||
Worksheets("Kuntarajat").Range("A1:H39833").Copy
|
||
MsgBox "OK! Kuntarajat.kml kopioitu leikepöydälle. Löydetty " & found & "/" & kaikki
|
||
End Sub
|
||
|
||
'***********'
|
||
Sub tilastot()
|
||
If Yht > 0 Then
|
||
stats = "#" & sija & " " & Kunta & " Yhteensä " & Yht & "# "
|
||
If Tradi > 0 Then
|
||
stats = stats & " / Tradi " & Tradi
|
||
End If
|
||
If Multi > 0 Then
|
||
stats = stats & " / Multi " & Multi
|
||
End If
|
||
If Mysteeri > 0 Then
|
||
stats = stats & " / Mysteeri " & Mysteeri
|
||
End If
|
||
If Letterbox > 0 Then
|
||
stats = stats & " / Letterbox " & Letterbox
|
||
End If
|
||
If Earth > 0 Then
|
||
stats = stats & " / Earthcache " & Earth
|
||
End If
|
||
If Wherigo > 0 Then
|
||
stats = stats & " / Wherigo " & Wherigo
|
||
End If
|
||
If Miitti > 0 Then
|
||
stats = stats & " / Miitti " & Miitti
|
||
End If
|
||
If CITO > 0 Then
|
||
stats = stats & " / CITO " & CITO
|
||
End If
|
||
If Mega > 0 Then
|
||
stats = stats & " / Mega " & Mega
|
||
End If
|
||
If Webcam > 0 Then
|
||
stats = stats & " / Webcam " & Webcam
|
||
End If
|
||
If Virtuaali > 0 Then
|
||
stats = stats & " / Virtuaali " & Virtuaali
|
||
End If
|
||
If Locationless > 0 Then
|
||
stats = stats & " / Locationless " & Locationless
|
||
End If
|
||
If Miitti10v > 0 Then
|
||
stats = stats & " / Miitti10v " & Miitti10v
|
||
End If
|
||
Else
|
||
stats = "#" & Kunta & " yhteensä " & Yht & "#"
|
||
End If
|
||
End Sub
|
||
|
||
'***********'
|
||
|
||
Sub pasteTilasto()
|
||
Worksheets("Tilasto").Columns("A:Z").Value = ""
|
||
ActiveSheet.Range("A5").Select
|
||
ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
|
||
False, NoHTMLFormatting:=True
|
||
End Sub
|