北アルプス水晶岳、高天原

北アルプス、十分堪能してきました。しかも、35年振りの高天原温泉入浴を果たし、大満足です。しかし、この年でテントを持って北アルプスは辛い。膝はもちましたが、考えさせられた4日間でした。

15日(土)新穂高温泉無料駐車場-鏡平-双六小屋-三俣山荘キャンプ場
16日(日)キャンプ場-黒部源流-岩苔乗越-水晶小屋(赤岳)-水晶岳(黒岳)-ワリモ岳-鷲羽岳-三俣山荘キャンプ場(泊)
17日(月)キャンプ場-雲ノ平-高天原温泉-岩苔乗越-黒部源流-三俣山荘キャンプ場(泊)
18日(火)キャンプ場-三俣蓮華岳-双六岳-鏡平-新穂高温泉駐車場

高天原温泉も最高でしたが、高天原から岩苔乗越へのルートはこの時期雲ノ平より花盛りでした。

↓定番の鏡平から槍・穂高連峰展望
鏡平

↓三俣山荘キャンプ場から水晶岳(左奥)、ワリモ岳(中央)、鷲羽岳(右)を眺める。
鷲羽岳

↓水晶岳(黒岳)より撮影。手前から順に赤岳(水晶小屋)、ワリモ岳、鷲羽岳、右に岩苔乗越、その後は双六岳。背後は左から常念岳、槍・穂高、乗鞍岳
水晶岳

詳細レポは完成次第本家サイトへ掲載します。
スポンサーサイト
THEME:登山 | GENRE:スポーツ |

奥飛騨うろうろ

テント持参して北アルプス目指すが、天候が悪く登らず撤退

6日(木)うだる暑さから逃れるように長野へ。上高地手前の道の駅「風穴の里」で様子見&車中泊。
7日(金)曇り時々激しい雨。意を決して岐阜側へ移動。奥穂高温泉郷道の駅「上宝」で停滞。いったん、新穂高温泉の無料駐車場を覗くが、脇の谷川は濁流で恐れをなし道の駅へ撤退。そのまま車中泊。
8日(土)天候回復は、期待通りではないので北アルプスはあきらめ、安房峠を越えて埼玉へ帰宅。

残念だけど、良い避暑になりました。。ネットの週間天気予報を鵜呑みにした自分が馬鹿でした次回は、天気図見て自分で判断します。
せめて焼岳でも登ろうかと色気を出したが、天気も悪く、あいにく登山口の駐車スペースもなし。
まぁ~、天気が悪いのにテント泊も大変だし、いい判断かな・・・・

↓証拠の写真。道の駅から焼岳(7日午後一瞬の晴れ間を逃さずパチリ)
焼岳
THEME:アウトドア | GENRE:趣味・実用 |

MS-EXCEL VBAで経緯度取得

GPS用地図を作っていて、下図のようにエクセルで緯度経度を取得する自作関数(VBA)が作れればいいなと思った。
↓A1セルに地名または住所を入力すると、B1セルに経度、C1に緯度が表示される。


ネットを調べたら参考になりそうなのがありました。
http://www.simple-sys.com/blog/2008/04/06/301/
http://www.happy2-island.com/vbs/cafe02/capter00701.shtml
いわゆる”スクレイピング”という技術で、「YAHOO!MAP」にアクセスして経緯度情報だけ「削り取る」動作をVBAでコーディングして、自作関数としてセルへ埋め込むという仕掛けです。

普通にWEB上で「札幌駅」と入力して「検索ボタン」を押し、複数の候補から「札幌駅」をクリックすると地図が表示されますが、その時のURLに経緯度情報が含まれています。これを削り取ってくるのです。下のアンダーライン部がそうです。
http://map.yahoo.co.jp/pl?p=%BB%A5%CB%DA%B1%D8&lat=43.065638&lon=141.35427733&type=&ei=euc-jp&v=2&sc=3&lnm=%BB%A5%CB%DA%B1%D8&idx=25

ただし、「YAHOO!MAP」は測地系がTOKYOなのでWGS84への変換関数も組み込みました。変換式は下記サイトの簡便式「三角関数を使わない式」を採用。今回はこれで十分でした。
http://homepage3.nifty.com/Nowral/02_DATUM/02_DATUM.html#HowTo

その結果、私が少し手を加え完成させたEXCEL自作関数がこれ↓


Function 関数地名to経度変換(p As String)
'「yahoo!map」から経度緯度情報(datum=tokyo)を取得する自作関数
'セルへ埋め込む自作関数として機能する。
'戻り値はTOKYOからWSG84へ変換してあります。
'p: 地点名(漢字) ln: 経度 la:緯度

Dim Address, result_str, Title, chk As String
Dim ln, la As String
Dim n1, n2, n3 As Integer

Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True

Address = p
objIE.navigate "http://map.yahoo.co.jp/"

Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

Title = objIE.LocationName

objIE.document.forms(1).Item("search_ms_p").Value = Address
objIE.document.forms(1).Item("search_ms_submit").Click

Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

chk = objIE.LocationName
Do While chk = Title
chk = objIE.LocationName
DoEvents
Loop

Title = objIE.LocationName
Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

result_str = objIE.document.links(20).href
n1 = Application.WorksheetFunction.Find("&lat=", result_str, 1)
n2 = Application.WorksheetFunction.Find("&lon=", result_str, 1)
n3 = Application.WorksheetFunction.Find("&type", result_str, 1)

ln = Mid(result_str, n2 + 5, n3 - n2 - 5)
la = Mid(result_str, n1 + 5, n2 - n1 - 5)

'WGS84へ数値変換
関数地名to経度変換 = TKY2WGS経度(ln, la)

objIE.Quit
Set objIE = Nothing
End Function


Function 関数地名to緯度変換(p As String)
'p: 地点名(漢字) ln: 経度 la:緯度

Dim Address, result_str, Title, chk As String
Dim ln, la As String
Dim n1, n2, n3 As Integer

Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True

Address = p
objIE.navigate "http://map.yahoo.co.jp/"

Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

Title = objIE.LocationName
objIE.document.forms(1).Item("search_ms_p").Value = Address
objIE.document.forms(1).Item("search_ms_submit").Click

Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

chk = objIE.LocationName
Do While chk = Title
chk = objIE.LocationName
DoEvents
Loop

Title = objIE.LocationName
Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

result_str = objIE.document.links(20).href
n1 = Application.WorksheetFunction.Find("&lat=", result_str, 1)
n2 = Application.WorksheetFunction.Find("&lon=", result_str, 1)
n3 = Application.WorksheetFunction.Find("&type", result_str, 1)

ln = Mid(result_str, n2 + 5, n3 - n2 - 5)
la = Mid(result_str, n1 + 5, n2 - n1 - 5)

'WGS84へ数値変換
関数地名to緯度変換 = TKY2WGS緯度(ln, la)

objIE.Quit
Set objIE = Nothing
End Function

Function TKY2WGS緯度(東経 As Variant, 北緯 As Variant)
'測地系TOKYOの数値をWGS84系へ変換する(簡易)
'東経:入力経度、北緯:入力緯度、lng:変換後経度、lat:変換後緯度

lng = 東経 - 北緯 * 0.000046038 - 東経 * 0.000083043 + 0.01004
lat = 北緯 - 北緯 * 0.00010695 + 東経 * 0.000017464 + 0.0046017
TKY2WGS緯度 = Format(lat, "#00.0000000")
End Function

Function TKY2WGS経度(東経 As Variant, 北緯 As Variant)
'測地系TOKYOの数値をWGS84系へ変換する(簡易)
'東経:入力経度、北緯:入力緯度、lng:変換後経度、lat:変換後緯度

lng = 東経 - 北緯 * 0.000046038 - 東経 * 0.000083043 + 0.01004
lat = 北緯 - 北緯 * 0.00010695 + 東経 * 0.000017464 + 0.0046017
TKY2WGS経度 = Format(lng, "#00.0000000")
End Function


さて、この自作関数(ユーザー関数)の使い方ですが、汎用関数と同じようにメニューの挿入(I)-関数(F)-関数の貼り付け、を開き関数の分類で一番下の「ユーザー定義」を選択し、右の窓から経度なら「関数地名to経度変換」を、緯度なら「関数地名to緯度変換」をクリックします。

scraping02.jpg

次にパラメータとして「地名」セルを指定します。
scraping03.jpg

このページ冒頭の図のように経度と緯度が出れば完成です。

ただ実際に使用すると、次のような問題が発生しあまり実用的ではなかった。残念!
1.「計算方法」を手動にしておいても「ウインドウ」がパカパカと何回も(通常3回)開き、わずらわしい。自動計算を完全に抑制できないのです(泣)。
2.複数候補があると選択画面でフリーズして自動で閉じない時がある。
3.「札幌駅」などのような固有地名なら精度は高いが、「札幌市北7条」のような住所ではあまり当てにならない。「カシミール3D」や「ウォッチ地図」から引いたほうが早いかも。

多くの地名を調べたいときは自作関数ではなく、こちらのマクロで一括処理した方が良い。
WGS84へ変換して出力するので、上述の測地系変換関数が必要です。
なんか、こちらのほうがストレスが少なくて使い勝手がよさそう(^^)v


Sub 地名to経緯度変換()
'yahoo!mapから経度緯度情報(datum=tokyo)を取得し
'WGS84へ変換して出力するVBA

Dim Address, result_str, Title, chk As String
Dim n1, n2, n3 As Integer
Dim la, ln As String

Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True
Range(Cells(1, 2), Cells(Range("A65536").End(xlUp).Row, 3)).Cells.Value = ""

For i = 1 To Range("A65536").End(xlUp).Row Step 1
Address = Cells(i, 1).Value
objIE.navigate "http://map.yahoo.co.jp/"

Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

Title = objIE.LocationName

objIE.document.forms(1).Item("search_ms_p").Value = Address
objIE.document.forms(1).Item("search_ms_submit").Click

Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

chk = objIE.LocationName
Do While chk = Title
chk = objIE.LocationName
DoEvents
Loop

Title = objIE.LocationName
Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

result_str = objIE.document.links(20).href
n1 = Application.WorksheetFunction.Find("&lat=", result_str, 1)
n2 = Application.WorksheetFunction.Find("&lon=", result_str, 1)
n3 = Application.WorksheetFunction.Find("&type", result_str, 1)

la = Mid(result_str, n1 + 5, n2 - n1 - 5)
ln = Mid(result_str, n2 + 5, n3 - n2 - 5)

'WGS84へ数値変換
Cells(i, 2).Value = TKY2WGS緯度(ln, la)
Cells(i, 3).Value = TKY2WGS経度(ln, la)

Next i
objIE.Quit
Set objIE = Nothing
End Sub
THEME:アウトドア | GENRE:趣味・実用 |
プロフィール

アベル父さん

Author:アベル父さん
団塊世代、男

最近のトラックバック
月別アーカイブ
FC2カウンター