.
This commit is contained in:
geohärö
parent
332e181841
commit
2c9d46cb1e
6 changed files with 40121 additions and 742 deletions
39805
Kunnat2017.kml
Normal file
39805
Kunnat2017.kml
Normal file
File diff suppressed because one or more lines are too long
627
Kuntarajat.py
627
Kuntarajat.py
File diff suppressed because it is too large
Load diff
|
|
@ -23,7 +23,7 @@ Lataa [Kuntarajat.py](https://github.com/geoharo/Geokml/blob/master/Kuntarajat.p
|
|||
Vaihtoehtoisesti voit [ajaa scriptin nettiselaimessa](https://repl.it/FNVg/0) ilman mitään asennuksia, mutta joudut kopioimaan outputin käsin ja kml-tiedoston luominen täytyy tehdä manuaalisesti.
|
||||
#######################################################
|
||||
|
||||
|
||||
Perustuu Maanmittauslaitoksen aineistoon.
|
||||
|
||||
Tarvittaessa [ota yhteyttä!](https://www.geocaching.com/email/?guid=d30ee7cc-018f-4e64-a4b1-06c4011e4f63)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,165 +0,0 @@
|
|||
Option Explicit
|
||||
Dim lastPQ As Long
|
||||
Dim lastG As Long
|
||||
Dim i As Long
|
||||
Dim j As Integer
|
||||
Dim ilmoita As Long
|
||||
Dim latD As String
|
||||
Dim lonD As String
|
||||
Dim A As Range
|
||||
Dim B As Range
|
||||
Dim latbefore As Range
|
||||
Dim corrected As Boolean
|
||||
Dim GC As String
|
||||
Dim graticule As Range
|
||||
Dim maa As Range
|
||||
Dim country As String
|
||||
Dim found As Integer
|
||||
|
||||
Sub Graticulet()
|
||||
Call clean
|
||||
lastPQ = Worksheets("All Finds PQ").Range("A" & Rows.Count).End(xlUp).Row
|
||||
Set A = Range(Worksheets("All Finds PQ").Cells(1, 1), Worksheets("All Finds PQ").Cells(lastPQ, 1)).Find("<?xml version")
|
||||
If Not A Is Nothing Then
|
||||
For i = 1 To lastPQ
|
||||
Worksheets("All Finds PQ").Range("Q1").Value = i & "/" & lastPQ
|
||||
Call etsi
|
||||
Next i
|
||||
End If
|
||||
|
||||
|
||||
Call taulu
|
||||
Call viherrys
|
||||
End Sub
|
||||
|
||||
Sub clean()
|
||||
Worksheets("All Finds PQ").Range("A:A").Interior.ColorIndex = 0
|
||||
Worksheets("All Finds PQ").Range("B:Z").Value = ""
|
||||
Worksheets("All Finds PQ").Range("M1").Value = "GC muut"
|
||||
Worksheets("All Finds PQ").Range("N1").Value = "Graticule muut"
|
||||
Worksheets("All Finds PQ").Range("O1").Value = "Maa"
|
||||
Worksheets("All Finds PQ").Range("J1").Value = "GC"
|
||||
Worksheets("All Finds PQ").Range("K1").Value = "Graticule FI"
|
||||
Worksheets("All Finds PQ").Range("Q2").Value = "Odota..."
|
||||
Worksheets("Graticuletaulu").Range("A:B").ClearContents
|
||||
Application.Wait (Now + 0.000000001)
|
||||
End Sub
|
||||
|
||||
Sub pastegpx()
|
||||
Worksheets("All Finds PQ").Columns("A:Z").Interior.ColorIndex = 0
|
||||
Worksheets("All Finds PQ").Columns("A:Z").Value = ""
|
||||
ActiveSheet.Range("A6").Select
|
||||
ActiveSheet.paste
|
||||
End Sub
|
||||
|
||||
'#####################'
|
||||
Sub etsi()
|
||||
Set A = Range(Worksheets("All Finds PQ").Cells(A.Row + 1, 1), Worksheets("All Finds PQ").Cells(lastPQ, 1)).Find("<wpt")
|
||||
If Not A Is Nothing Then
|
||||
i = A.Row
|
||||
GC = Replace(Replace(Replace(Worksheets("All Finds PQ").Cells(A.Row + 2, 1).Value, "<name>", ""), "</name>", ""), " ", "")
|
||||
If InStr(1, GC, "GC") <> 1 Then
|
||||
Exit Sub
|
||||
End If
|
||||
Set B = Range(Worksheets("All Finds PQ").Cells(A.Row, 1), Worksheets("All Finds PQ").Cells(lastPQ, 1)).Find("</wpt>")
|
||||
Set maa = Worksheets("All Finds PQ").Range(Cells(A.Row, 1), Cells(B.Row, 1)).Find("<groundspeak:country>")
|
||||
country = Replace(Replace(Replace(Cells(maa.Row, maa.Column), " <groundspeak:country>", ""), "</groundspeak:country>", ""), " ", "")
|
||||
Else
|
||||
i = lastPQ
|
||||
Worksheets("All Finds PQ").Range("Q1").Value = i & "/" & lastPQ
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If Worksheets("All Finds PQ").Cells(A.Row - 1, 1).Interior.Color <> RGB(146, 208, 80) Then
|
||||
Range(Worksheets("All Finds PQ").Cells(A.Row, 1), Worksheets("All Finds PQ").Cells(B.Row, 1)).Interior.Color = RGB(146, 208, 80)
|
||||
Else
|
||||
Range(Worksheets("All Finds PQ").Cells(A.Row, 1), Worksheets("All Finds PQ").Cells(B.Row, 1)).Interior.Color = RGB(87, 128, 201)
|
||||
End If
|
||||
|
||||
Set latbefore = Range(Worksheets("All Finds PQ").Cells(A.Row, 1), Worksheets("All Finds PQ").Cells(B.Row, 1)).Find("<gsak:LatBeforeCorrect>")
|
||||
If Not latbefore Is Nothing Then
|
||||
corrected = True
|
||||
Else
|
||||
corrected = False
|
||||
End If
|
||||
|
||||
If corrected = True Then
|
||||
If InStr(1, Worksheets("All Finds PQ").Cells(latbefore.Row, 1).Value, ".") > 0 Then
|
||||
latD = "N" & Mid(Worksheets("All Finds PQ").Cells(latbefore.Row, 1).Value, InStr(1, Worksheets("All Finds PQ").Cells(latbefore.Row, 1).Value, "LatBeforeCorrect>") + 17, InStr(1, Worksheets("All Finds PQ").Cells(latbefore.Row, 1).Value, ".") - InStr(1, Worksheets("All Finds PQ").Cells(latbefore.Row, 1).Value, "<gsak:LatBeforeCorrect>") - 23)
|
||||
Else
|
||||
latD = "N" & Mid(Worksheets("All Finds PQ").Cells(latbefore.Row, 1).Value, InStr(1, Worksheets("All Finds PQ").Cells(latbefore.Row, 1).Value, "LatBeforeCorrect>") + 17, InStr(1, Worksheets("All Finds PQ").Cells(latbefore.Row, 1).Value, "</gsak:LatBeforeCorrect>") - InStr(1, Worksheets("All Finds PQ").Cells(latbefore.Row, 1).Value, "<gsak:LatBeforeCorrect>") - 23)
|
||||
End If
|
||||
latD = Replace(latD, "N-", "S")
|
||||
|
||||
If InStr(1, Worksheets("All Finds PQ").Cells(latbefore.Row + 1, 1).Value, ".") > 0 Then
|
||||
lonD = "E" & Mid(Worksheets("All Finds PQ").Cells(latbefore.Row + 1, 1).Value, InStr(1, Worksheets("All Finds PQ").Cells(latbefore.Row + 1, 1).Value, "LonBeforeCorrect>") + 17, InStr(1, Worksheets("All Finds PQ").Cells(latbefore.Row + 1, 1).Value, ".") - InStr(1, Worksheets("All Finds PQ").Cells(latbefore.Row + 1, 1).Value, "<gsak:LonBeforeCorrect>") - 23)
|
||||
Else
|
||||
lonD = "E" & Mid(Worksheets("All Finds PQ").Cells(latbefore.Row + 1, 1).Value, InStr(1, Worksheets("All Finds PQ").Cells(latbefore.Row + 1, 1).Value, "LonBeforeCorrect>") + 17, InStr(1, Worksheets("All Finds PQ").Cells(latbefore.Row + 1, 1).Value, "</gsak:LonBeforeCorrect>") - InStr(1, Worksheets("All Finds PQ").Cells(latbefore.Row + 1, 1).Value, "<gsak:LonBeforeCorrect>") - 23)
|
||||
End If
|
||||
lonD = Replace(lonD, "E-", "W")
|
||||
Else
|
||||
If InStr(1, Mid(Worksheets("All Finds PQ").Cells(A.Row, 1).Value, InStr(1, Worksheets("All Finds PQ").Cells(A.Row, 1).Value, "<wpt lat=""") + 10, InStr(1, Worksheets("All Finds PQ").Cells(A.Row, 1).Value, """ lon=""") - InStr(1, Worksheets("All Finds PQ").Cells(A.Row, 1).Value, "<wpt lat=""") - 10), ".") > 0 Then
|
||||
latD = "N" & Mid(Worksheets("All Finds PQ").Cells(A.Row, 1).Value, InStr(1, Worksheets("All Finds PQ").Cells(A.Row, 1).Value, "<wpt lat=""") + 10, InStr(1, Worksheets("All Finds PQ").Cells(A.Row, 1).Value, ".") - InStr(1, Worksheets("All Finds PQ").Cells(A.Row, 1).Value, "<wpt lat=""") - 10)
|
||||
Else
|
||||
latD = "N" & Mid(Worksheets("All Finds PQ").Cells(A.Row, 1).Value, InStr(1, Worksheets("All Finds PQ").Cells(A.Row, 1).Value, "<wpt lat=""") + 10, InStr(1, Worksheets("All Finds PQ").Cells(A.Row, 1).Value, """ lon=""") - InStr(1, Worksheets("All Finds PQ").Cells(A.Row, 1).Value, "<wpt lat=""") - 10)
|
||||
End If
|
||||
latD = Replace(latD, "N-", "S")
|
||||
|
||||
If InStr(1, Mid(Worksheets("All Finds PQ").Cells(A.Row, 1).Value, InStr(1, Worksheets("All Finds PQ").Cells(A.Row, 1).Value, """ lon=""") + 7), ".") > 0 Then
|
||||
lonD = "E" & Mid(Worksheets("All Finds PQ").Cells(A.Row, 1).Value, InStr(1, Worksheets("All Finds PQ").Cells(A.Row, 1).Value, """ lon=""") + 7, InStr(InStr(1, Worksheets("All Finds PQ").Cells(A.Row, 1).Value, """ lon="""), Worksheets("All Finds PQ").Cells(A.Row, 1).Value, ".") - InStr(1, Worksheets("All Finds PQ").Cells(A.Row, 1).Value, """ lon=""") - 7)
|
||||
Else
|
||||
lonD = "E" & Mid(Worksheets("All Finds PQ").Cells(A.Row, 1).Value, InStr(1, Worksheets("All Finds PQ").Cells(A.Row, 1).Value, """ lon=""") + 7, InStr(1, Worksheets("All Finds PQ").Cells(A.Row, 1).Value, """>") - InStr(1, Worksheets("All Finds PQ").Cells(A.Row, 1).Value, """ lon=""") - 7)
|
||||
End If
|
||||
lonD = Replace(lonD, "E-", "W")
|
||||
End If
|
||||
|
||||
|
||||
If country = "Finland" And GC <> "GCGW7N" And GC <> "GCC5EE" Then
|
||||
ilmoita = Worksheets("All Finds PQ").Range("J" & Rows.Count).End(xlUp).Row + 1
|
||||
Worksheets("All Finds PQ").Range("J" & ilmoita).Value = GC
|
||||
Worksheets("All Finds PQ").Range("K" & ilmoita).Value = latD & lonD
|
||||
|
||||
Else
|
||||
ilmoita = Worksheets("All Finds PQ").Range("M" & Rows.Count).End(xlUp).Row + 1
|
||||
Worksheets("All Finds PQ").Range("M" & ilmoita).Value = GC
|
||||
Worksheets("All Finds PQ").Range("N" & ilmoita).Value = latD & lonD
|
||||
Worksheets("All Finds PQ").Range("O" & ilmoita).Value = country
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub taulu()
|
||||
For i = 2 To 13
|
||||
For j = 3 To 15
|
||||
If Worksheets("Graticuletaulu").Range(Chr(Asc("A") + j) & i).Interior.ColorIndex <> 15 Then
|
||||
Worksheets("Graticuletaulu").Range(Chr(Asc("A") + j) & i).Formula = "=COUNTIF('All Finds PQ'!K:K," & """N" & 72 - i & "E" & 16 + j & """" & ")"
|
||||
End If
|
||||
Next j
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
|
||||
Sub viherrys()
|
||||
Worksheets("Graticuletaulu").Range("A:B").ClearContents
|
||||
For i = 2 To 13
|
||||
For j = 4 To 16
|
||||
If Worksheets("Graticuletaulu").Cells(i, j).Interior.ColorIndex <> 15 Then
|
||||
Dim grat As String
|
||||
grat = "N" & 72 - i & "E" & 15 + j
|
||||
Set graticule = Worksheets("Graticulet").Range("D:D").Find(grat)
|
||||
Worksheets("Graticulet").Cells(graticule.Row + 1, 4).Value = "<description><![CDATA[" & Worksheets("Graticuletaulu").Cells(i, j).Value & "]]></description>"
|
||||
If Worksheets("Graticuletaulu").Cells(i, j).Value <> 0 Then
|
||||
Worksheets("Graticulet").Cells(graticule.Row + 2, 4).Value = "<styleUrl>#poly-00D079-1-59</styleUrl>"
|
||||
Else
|
||||
Worksheets("Graticulet").Cells(graticule.Row + 2, 4).Value = "<styleUrl>#poly-DB4436-1-64</styleUrl>"
|
||||
End If
|
||||
End If
|
||||
Next j
|
||||
Next i
|
||||
found = WorksheetFunction.CountIf(Worksheets("Graticuletaulu").Range("D2:P13"), "<>0") - WorksheetFunction.CountBlank(Worksheets("Graticuletaulu").Range("D2:P13"))
|
||||
Worksheets("All Finds PQ").Range("Q2").Value = "Valmis! Löydetty " & found & "/" & 97 & " =" & Round(found / 97 * 100, 2) & "%"
|
||||
Worksheets("Graticuletaulu").Range("A8").Value = "Valmis!"
|
||||
Worksheets("Graticuletaulu").Range("A9").Value = "Löydetty " & found & "/" & 97 & " =" & Round(found / 97 * 100, 2) & "%"
|
||||
Worksheets("Graticulet").Range("A1:G39833").Copy
|
||||
MsgBox "OK! Graticule.kml kopioitu leikepöydälle. Löydetty " & found & "/" & 97
|
||||
End Sub
|
||||
|
|
@ -1,142 +0,0 @@
|
|||
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
|
||||
|
|
@ -1,122 +0,0 @@
|
|||
Option Explicit
|
||||
|
||||
Dim lastPQ As Long
|
||||
Dim lastWP As Long
|
||||
Dim i As Long
|
||||
Dim x As Range
|
||||
Dim lat As String
|
||||
Dim lon As String
|
||||
Dim GC As String
|
||||
Dim nimi As String
|
||||
Dim desc As String
|
||||
Dim size As String
|
||||
Dim kpl As Long
|
||||
Dim cachetype As String
|
||||
Dim A As Long
|
||||
Dim B As Long
|
||||
Dim hint As String
|
||||
|
||||
Sub tyhj()
|
||||
If InStr(1, Worksheets("Reittipisteet").Range("C5").Value, "<Style id='") = 0 Then
|
||||
Set x = Worksheets("Reittipisteet").Range("C:C").Find("<Style id='")
|
||||
Worksheets("Reittipisteet").Rows("5:" & x.Row - 1).Delete Shift:=xlUp
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Sub Waypoints()
|
||||
Worksheets("PocketQ").Range("K1:L1").Value = ""
|
||||
kpl = 0
|
||||
|
||||
Call tyhj
|
||||
|
||||
Set x = Range("A1")
|
||||
lastPQ = Worksheets("PocketQ").Range("A" & Rows.Count).End(xlUp).Row
|
||||
|
||||
For i = 1 To lastPQ
|
||||
Worksheets("PocketQ").Range("K1").Value = "'" & i & "/" & lastPQ
|
||||
Set x = Worksheets("PocketQ").Range(Worksheets("PocketQ").Cells(x.Row + 1, 1), Worksheets("PocketQ").Cells(lastPQ, 1)).Find("<wpt lat=""")
|
||||
If Not x Is Nothing Then
|
||||
|
||||
i = x.Row
|
||||
kpl = kpl + 1
|
||||
Worksheets("PocketQ").Range("L1").Value = kpl
|
||||
|
||||
|
||||
Do Until InStr(1, Worksheets("PocketQ").Cells(i, 1).Value, "<groundspeak:encoded_hints>") > 0
|
||||
i = i + 1
|
||||
Loop
|
||||
A = i
|
||||
Do Until InStr(1, Worksheets("PocketQ").Cells(i, 1).Value, "</groundspeak:encoded_hints>") > 0
|
||||
i = i + 1
|
||||
Loop
|
||||
B = i
|
||||
|
||||
|
||||
|
||||
|
||||
lat = Mid(Worksheets("PocketQ").Cells(x.Row, 1).Value, InStr(1, Worksheets("PocketQ").Cells(x.Row, 1).Value, "<wpt lat=""") + 10, InStr(1, Worksheets("PocketQ").Cells(x.Row, 1).Value, """ lon=""") - InStr(1, Worksheets("PocketQ").Cells(x.Row, 1).Value, "<wpt lat=""") - 10)
|
||||
lon = Mid(Worksheets("PocketQ").Cells(x.Row, 1).Value, InStr(1, Worksheets("PocketQ").Cells(x.Row, 1).Value, """ lon=""") + 7, InStr(1, Worksheets("PocketQ").Cells(x.Row, 1).Value, """>") - InStr(1, Worksheets("PocketQ").Cells(x.Row, 1).Value, """ lon=""") - 7)
|
||||
GC = Mid(Worksheets("PocketQ").Cells(x.Row + 2, 1).Value, InStr(1, Worksheets("PocketQ").Cells(x.Row + 2, 1).Value, "<name>") + 6, InStr(1, Worksheets("PocketQ").Cells(x.Row + 2, 1).Value, "</name>") - InStr(1, Worksheets("PocketQ").Cells(x.Row + 2, 1).Value, "<name>") - 6)
|
||||
nimi = Mid(Worksheets("PocketQ").Cells(x.Row + 5, 1).Value, InStr(1, Worksheets("PocketQ").Cells(x.Row + 5, 1).Value, "<urlname>") + 9, InStr(1, Worksheets("PocketQ").Cells(x.Row + 5, 1).Value, "</urlname>") - InStr(1, Worksheets("PocketQ").Cells(x.Row + 5, 1).Value, "<urlname>") - 9)
|
||||
desc = Replace(Mid(Worksheets("PocketQ").Cells(x.Row + 3, 1).Value, InStr(1, Worksheets("PocketQ").Cells(x.Row + 3, 1).Value, "<desc>") + 6, InStr(1, Worksheets("PocketQ").Cells(x.Row + 3, 1).Value, "</desc>") - InStr(1, Worksheets("PocketQ").Cells(x.Row + 3, 1).Value, "<desc>") - 6), "&", "&")
|
||||
size = Mid(Worksheets("PocketQ").Cells(x.Row + 13, 1).Value, InStr(1, Worksheets("PocketQ").Cells(x.Row + 13, 1).Value, "<groundspeak:container>") + 23, InStr(1, Worksheets("PocketQ").Cells(x.Row + 13, 1).Value, "</groundspeak:container>") - InStr(1, Worksheets("PocketQ").Cells(x.Row + 13, 1).Value, "<groundspeak:container>") - 23)
|
||||
cachetype = Replace(Mid(Worksheets("PocketQ").Cells(x.Row + 7, 1).Value, InStr(1, Worksheets("PocketQ").Cells(x.Row + 7, 1).Value, "<type>Geocache|") + 15), "</type>", "")
|
||||
|
||||
hint = ""
|
||||
For A = A To B
|
||||
hint = hint & " " & Replace(Replace(Worksheets("PocketQ").Cells(A, 1).Value, " <groundspeak:encoded_hints>", ""), "</groundspeak:encoded_hints>", "")
|
||||
Next A
|
||||
Do Until InStr(1, hint, " ") <> 1
|
||||
hint = Mid(hint, 2)
|
||||
Loop
|
||||
If hint = "" Then
|
||||
hint = "Ei vihjettä"
|
||||
End If
|
||||
|
||||
|
||||
|
||||
Worksheets("Reittipisteet").Rows("5:12").Insert Shift:=xlDown
|
||||
Worksheets("Reittipisteet").Cells(5, 3).Value = "<Placemark>"
|
||||
Worksheets("Reittipisteet").Cells(6, 3).Value = "<description><![CDATA[" & "<a href=""https://coord.info/" & GC & """>" & GC & "</a>" & "<br>" & desc & " " & size & " Vihje: " & hint & "]]></description>"
|
||||
Worksheets("Reittipisteet").Cells(7, 4).Value = "<name>" & nimi & "</name>"
|
||||
If cachetype = "Traditional Cache" Then
|
||||
Worksheets("Reittipisteet").Cells(8, 4).Value = "<styleUrl>#icon-1899-0F9D58</styleUrl>"
|
||||
ElseIf cachetype = "Multi-cache" Then
|
||||
Worksheets("Reittipisteet").Cells(8, 4).Value = "<styleUrl>#icon-1899-F57C00</styleUrl>"
|
||||
ElseIf cachetype = "Unknown Cache" Then
|
||||
Worksheets("Reittipisteet").Cells(8, 4).Value = "<styleUrl>#icon-1594-1A237E</styleUrl>"
|
||||
ElseIf cachetype = "Letterbox Hybrid" Then
|
||||
Worksheets("Reittipisteet").Cells(8, 4).Value = "<styleUrl>#icon-1899-C2185B</styleUrl>"
|
||||
ElseIf cachetype = "Wherigo Cache" Then
|
||||
Worksheets("Reittipisteet").Cells(8, 4).Value = "<styleUrl>#icon-1899-9C27B0</styleUrl>"
|
||||
ElseIf cachetype = "Earthcache" Then
|
||||
Worksheets("Reittipisteet").Cells(8, 4).Value = "<styleUrl>#icon-1899-757575</styleUrl>"
|
||||
ElseIf cachetype = "Event Cache" Or cachetype = "Cache In Trash Out Event" Then
|
||||
Worksheets("Reittipisteet").Cells(8, 4).Value = "<styleUrl>#icon-1625-4E342E</styleUrl>"
|
||||
Else
|
||||
Worksheets("Reittipisteet").Cells(8, 4).Value = "<styleUrl>#icon-1899-0288D1-nodesc</styleUrl>"
|
||||
End If
|
||||
Worksheets("Reittipisteet").Cells(9, 4).Value = "<Point>"
|
||||
Worksheets("Reittipisteet").Cells(10, 5).Value = "<coordinates>" & lon & "," & lat & ",0.0</coordinates>"
|
||||
Worksheets("Reittipisteet").Cells(11, 4).Value = "</Point>"
|
||||
Worksheets("Reittipisteet").Cells(12, 3).Value = "</Placemark>"
|
||||
Else
|
||||
i = lastPQ
|
||||
End If
|
||||
|
||||
Next i
|
||||
|
||||
|
||||
|
||||
Worksheets("PocketQ").Range("L1").Value = "Valmis! " & kpl & "kpl"
|
||||
Set x = Worksheets("Reittipisteet").Range("A:A").Find("</kml>")
|
||||
Worksheets("Reittipisteet").Range("A1:H" & x.Row).Copy
|
||||
MsgBox "OK! Reittipisteet.kml kopioitu leikepöydälle. " & kpl & "kpl"
|
||||
End Sub
|
||||
|
||||
Sub pastePQ()
|
||||
Worksheets("PocketQ").Columns("A:Z").Value = ""
|
||||
Range("A6").Select
|
||||
ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:= _
|
||||
False
|
||||
End Sub
|
||||
Loading…
Reference in a new issue