-PR-
NTTPCのレンタルサーバー
基本情報技術者講座 28,000円から ★ぶっちぎり宅建ライブ開講★

GIOコードの計算をVBA化。

ネット上にメッシュコード関連の計算式があったので、Excelの関数として使えるようにVBA化しました。

参考にした計算式が乗っていたサイトは、残念ながら無くなってしまいましたが、魚拓がのこっていたので張り付けます↓

式をコード化したものが以下

‘—————————————————-
‘緯度経度から3次(1㎞)メッシュ
‘—————————————————-
Function LatLontoMesh(lat, lon)
Dim s1, a1
s1 = WorksheetFunction.Quotient(lat * 60, 40)
a1 = (lat * 60) – (s1 * 40)
s2 = WorksheetFunction.RoundDown(lon – 100, 0)
a2 = (lon – 100) – s2
s3 = WorksheetFunction.Quotient(a1, 5)
a3 = a1 – (s3 * 5)
s4 = WorksheetFunction.Quotient(a2 * 60, 7.5)
a4 = (a2 * 60) – (s4 * 7.5)
s5 = WorksheetFunction.Quotient(a3 * 60, 30)
s6 = WorksheetFunction.Quotient(a4 * 60, 45)

LatLontoMesh = s1 & s2 & s3 & s4 & s5 & s6
End Function

‘—————————————————-
‘3次(1㎞)メッシュから緯度経度を返す
‘—————————————————-
Function CalcLatLonFromMesh1km(mesh, ctr)
Dim strLat, strLon

‘5439-2308-2
‘3次LAT式
strLat = Left(mesh, 2) / 1.5 + (((Mid(mesh, 5, 1) * 5) / 100) / 60 * 100) + (((Mid(mesh, 7, 1) * 30) / 10000) / (60 * 60) * 10000)
‘3次LON式
strLon = Mid(mesh, 3, 2) + 100 + (((Mid(mesh, 6, 1) * 7.5) / 100) / 60 * 100) + (((Mid(mesh, 8, 1) * 45) / 10000) / (60 * 60) * 10000)

If ctr = “lat” Then CalcLatLonFromMesh1km = strLat
If ctr = “lon” Then CalcLatLonFromMesh1km = strLon

End Function

関連記事:

  1. 【excel VBA】スピードアップの簡単な7つの手法!
  2. [Excel VBA]プロフィール付座席表 配布
  3. 【excel VBA】Excel高速化おまけ。ループを減らす(もちろん)
  4. 【エクセルVBA】グループ化した行、列のコントロール
  5. 【ExcelVBA】3131 FROM 句の構文エラーについて

関連記事はYARPP関連記事プラグインによって表示されています。

Comments are closed.