基盤地図情報閲覧コンバートソフトで書き出したxyzファイルのID削除とxy入換はExcelde行うと手軽ですが
Excel2007の最大行数は「104万8576行」でちょっと広めの範囲を使いたい場合は軽くオーバーしてしまいます。
こんな場合のためにVBAでデータを読み出して1行づつ書き出すマクロを作りました。
少々時間はかかりますが変換できます。標高値を3倍にするとかいろいろ細かい処理も一緒にできそうです。
Excel VBA のソース
Option Explicit
Private Sub CommandButton1_Click()
Dim FileType, Prompt, Item As String
Dim FileNamePath, TempFileNamePath As Variant
Dim textline As String
Dim i As Integer
Dim ch1, ch2 As Long
Dim csv As Variant
FileType = "XYZファイル (*.xyz),*.xyz"
Prompt = "File を選択してください"
FileNamePath = SelectFileNamePath(FileType, Prompt) '操作したいファイルのパスを取得
If FileNamePath = False Then 'キャンセルボタンが押された
End
End If
' CommandButton1.Enabled = False
Cells(2, 1) = "変換中!"
'Cells(2, 1) = crlfCount(FileNamePath) '行数を求める(時間がかかる…)
'Application.ScreenUpdating = False
ch1 = FreeFile '空いているファイル番号を取得
Open FileNamePath For Input As #ch1 'FileNamePath のファイルをオープン
ch2 = FreeFile '書出し用ファイル番号を取得
csv = Split(FileNamePath, ".")
TempFileNamePath = csv(0) & "_cnv.xyz" '変換先ファイル名
Open TempFileNamePath For Output As #ch2 '変換先ファイルオープン
Do While Not EOF(1) 'ファイルの終端かどうかを確認
Line Input #ch1, textline 'データ行を読み込み
csv = Split(textline, ",")
textline = csv(2) & "," & csv(1) & "," & csv(3)
Print #ch2, textline 'データの書き込み
' Cells(1, 1) = csv(0) '変換中の行を表示(時間がかかる)
DoEvents
Loop
Close #ch1, #ch2 'ファイルを閉じます
'Kill FileNamePath '元のファイルを削除
'Name TempFileNamePath As FileNamePath '変換先ファイルを元のファイルの名前に変更
'Application.ScreenUpdating = True
Cells(2, 1) = "変換が終了しました"
'CommandButton1.Enabled = True
End Sub
Function SelectFileNamePath(FileType, Prompt) As Variant
SelectFileNamePath = Application.GetOpenFilename(FileType, , Prompt)
End Function
書き出したxyzファイルを直接読み込み、ファイル名を付けて書き出します。
xxxx.xyz ⇒ xxxx_conv.xyz
変換中は気長に待ちましょう・・・
