3Dプリンタで立体地図(3) Excel最大行超データの変換

基盤地図情報閲覧コンバートソフトで書き出したxyzファイルのID削除とxy入換はExcelde行うと手軽ですが
Excel2007の最大行数は「104万8576行」でちょっと広めの範囲を使いたい場合は軽くオーバーしてしまいます。
こんな場合のためにVBAでデータを読み出して1行づつ書き出すマクロを作りました。
少々時間はかかりますが変換できます。標高値を3倍にするとかいろいろ細かい処理も一緒にできそうです。

xyz_FileConv

 

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

変換中は気長に待ちましょう・・・