現状のマクロは、前の値と比較して差が大きい時に異常値と判断しているため、先頭の値が異常値の場合は先頭以降の正常値を全て異常値とみなし除外する場合が有り得る（今後の課題）。
'
' GPX取込分析 Macro
' 作成者：たけ
'
Dim S1, S2, S3 As Worksheet
Dim Target As String
Dim i, 前i, j, k As Long
Dim 終行, 前行 As Long
Dim 期日 As Date
Dim 時刻, 前時刻, 時刻差, 前時, 休時, 休長 As Single
Dim 高度, 前高度, 高度差 As Integer
Dim 緯度, 前緯度, 緯度差 As Single
Dim 軽度, 前経度, 経度差 As Single
Dim 時, 高, 緯, 経 As Integer
Dim 高度割合, 緯度割合, 経度割合 As Single
Dim 距離, 距離差, 前離, 東西差, 南北差 As Single
Dim 時速, 高速, 低速, 平均時速 As Single
Dim 回数, 経過, 速位 As Integer
Sub GPX取込分析()
'① 最初に分析したいＧＰＸファイルを「Sheet1」に取り込む。
Set S1 = Sheets("Sheet1")
Set S2 = Sheets("Sheet2")
Set S3 = Sheets("Sheet3")
Sheets("Sheet1").Select
S1.Range("A1:Z65536").ClearContents
Target = Application.GetOpenFilename("GPXファイル,*.gpx?")
If Target = "False" Then Exit Sub
With ActiveSheet.QueryTables.Add(Connection:="text;" & Target, Destination:=Range("B2"))
.AdjustColumnWidth = False
.TextFilePlatform = 932
.Refresh
.Parent.Names(.Name).Delete
.Delete
End With
終行 = S3.Range("B65536").End(xlUp).Row + 1
S3.Cells(終行, 1) = Target
'② 次にＧＰＸの生データを、時刻や緯度経度高度距離等で区分し時速を算出し「Sheet2」内のセルに保存する。
S2.Range("A3:Z65536").ClearContents
終行 = S1.Range("B65536").End(xlUp).Row - 3
j = 2
For i = 11 To 終行
If Left(S1.Cells(i, 2), 7) = "<trkpt " Then
j = j + 1
時 = InStr(S1.Cells(i, 2).Text, "<tim")
高 = InStr(S1.Cells(i, 2).Text, "<ele")
緯 = InStr(S1.Cells(i, 2).Text, "lat=")
経 = InStr(S1.Cells(i, 2).Text, "lon=")
If Mid(S1.Cells(i, 2), 時 + 17, 2) > "14" Then 日加 = 1 Else 日加 = 0
期日 = DateValue(Mid(S1.Cells(i, 2), 時 + 6, 10)) + 日加
時刻 = TimeValue(Mid(S1.Cells(i, 2), 時 + 17, 8)) + 9 / 24
時刻 = 時刻 - Int(時刻)
高度 = Mid(S1.Cells(i, 2), 高 + 5, 4)
緯度 = Mid(S1.Cells(i, 2), 緯 + 5, 16)
経度 = Mid(S1.Cells(i, 2), 経 + 5, 16)
S2.Cells(j, 2) = 期日
S2.Cells(j, 3) = 時刻
S2.Cells(j, 4) = 高度
S2.Cells(j, 5) = 緯度
S2.Cells(j, 6) = 経度
時刻差 = 時刻 - 前時刻
If i > 11 And 時刻差 > 0.00002 Then
高度差 = 高度 - 前高度
緯度差 = (緯度 - 前緯度) * 3600
経度差 = (経度 - 前経度) * 3600
高度割合 = Abs(高度差) / 時刻差
緯度割合 = Abs(緯度差) / 時刻差
経度割合 = Abs(経度差) / 時刻差
If 時刻差 < 0.00003 Or 高度割合 > 100000 Or 緯度割合 > 100000 Or 経度割合 > 100000 Then
j = j - 1
Else
東西差 = 緯度差 * 24.92
南北差 = 経度差 * 30.82
距離 = Sqr(東西差 ^ 2 + 南北差 ^ 2)
If 時刻差 > 0 Then 時速 = 距離 / 時刻差 / 24000 Else 距離 = 0: 時速 = 0
S2.Cells(j, 7) = 高度差
S2.Cells(j, 8) = 緯度差
S2.Cells(j, 9) = 経度差
S2.Cells(j, 10) = 時刻差
S2.Cells(j, 12) = 距離
S2.Cells(j, 14) = 時速
S2.Cells(j, 11) = WorksheetFunction.Sum(S2.Range("J3" & ":J" & j))
S2.Cells(j, 13) = WorksheetFunction.Sum(S2.Range("L3" & ":L" & j))
End If
Else
If 時刻差 < 0.00002 Then j = j - 1
End If
前時刻 = S2.Cells(j, 3)
前高度 = S2.Cells(j, 4)
前緯度 = S2.Cells(j, 5)
前経度 = S2.Cells(j, 6)
End If
Next i
'③ ５分単位と約１時間単位で時速を算出し休憩や登山速度変化の区間を割り出し「Sheet2」に追記する。
終行 = S2.Range("B65536").End(xlUp).Row
S2.Range("O3:Z65536").ClearContents
回数 = 1
経過 = 0
前行 = 3
高速 = 0: 低速 = 20
休時 = 0: 休長 = 0
For i = 4 To 終行
If S2.Cells(i, 14) < 0.7 And S2.Cells(i, 10) > 0.0001 Then 休時 = 休時 + S2.Cells(i, 10): 休長 = 休長 + S2.Cells(i, 12)
時間差 = S2.Cells(i, 11) - S2.Cells(前行, 11)
距離差 = S2.Cells(i, 13) - S2.Cells(前行, 13)
If 時間差 > 0.003473 Or i = 終行 Then
経過 = 経過 + 1
If 休時 > 0.001 Then 休時 = 0: 休長 = 0
時速 = (距離差 - 休長) / (時間差 - 休時) / 24000
Select Case 時速
Case Is < 0.6: 速位 = 1 ' 休憩
Case Is < 1.6: 速位 = 2 ' 慎重速度（急登or危険道）
Case Is < 2.7: 速位 = 3 ' 普通速度
Case Is < 4.5: 速位 = 4 ' 速足速度（下山道）
Case Else: 速位 = 5 ' 超速足速度（林道etc）
End Select
S2.Range("O" & (前行 + 1) & ":O" & i) = 時速
S2.Range("P" & (前行 + 1) & ":P" & i) = 速位
If 経過 < 10 And 時速 > 高速 Then 高速 = 時速
If 経過 < 10 And 時速 < 低速 Then 低速 = 時速
平均時速 = (高速 + 低速) / 2
If S2.Cells(前行, 16) = 1 Then
If 速位 > 1 Then 回数 = 回数 + 1: 経過 = 0: 高速 = 0: 低速 = 20
Else
If 速位 = 1 Then 回数 = 回数 + 1: 経過 = 0: 高速 = 0: 低速 = 20
End If
If 経過 > 10 And 速位 <> S2.Cells(前行, 16) And (時速 < 平均時速 * 0.6 Or 時速 > 平均時速 * 2) Then
If 時速 > 高速 Or 時速 < 低速 Then 回数 = 回数 + 1: 経過 = 0: 高速 = 0: 低速 = 20
End If
S2.Range("Q" & (前行 + 1)) = 回数
前行 = i
休時 = 0: 休長 = 0
End If
Next i
'④ 最後に「Sheet2」から歩行記録の大区分毎のデータを抽出して「Sheet3」に書き出す。
k = S3.Range("B65536").End(xlUp).Row + 2
S2.Range("A3:Z3").Copy S3.Range("A" & k & ":Z" & k)
前i = 1: 前時 = 0: 前離 = 0: k = k + 1
For i = 4 To 終行
If i = 終行 Or 前i < S2.Cells(i, 17) Then
時刻差 = S2.Cells(i - 1, 11) - 前時
距離差 = S2.Cells(i - 1, 13) - 前離
時速 = 距離差 / 時刻差 / 24000
S2.Cells(i - 1, 18) = 時速
前時 = S2.Cells(i - 1, 11)
前離 = S2.Cells(i - 1, 13)
前i = S2.Cells(i, 17)
S2.Range("A" & (i - 1) & ":Z" & (i - 1)).Copy S3.Range("A" & k & ":Z" & k)
S3.Cells(k, 7) = S3.Cells(k, 4) - S3.Cells(k - 1, 4)
S3.Cells(k, 10) = S3.Cells(k, 3) - S3.Cells(k - 1, 3)
S3.Cells(k, 12) = S3.Cells(k, 13) - S3.Cells(k - 1, 13)
S3.Range("H" & k & ":I" & k).ClearContents
S3.Range("N" & k & ":O" & k).ClearContents
k = k + 1
End If
Next i
End Sub
