165 lines
8.7 KiB
Text
165 lines
8.7 KiB
Text
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
|