| |
>あとは自分のほしい形に直してみます。
もう必要ないのかな？
面白そうなので作って見ました
ExcelのSheetに読み込まないで、直接CSVファイルに出力します
尚、
>テキストの形式は 固定バイト長だと思います。
と言う事ですし、データも半角そうなので、Randomファイルとして扱います
因って、以下のユーザー定義のバイト数を実情に合わせて下さい
また、通常Randomファイルは、読み込み位置を指定して読み込めば善いのですが？
一々、読み込み位置を計算するのがメンドクサイのと下記の方が気持ち速そうなので
別のやり方で作っています
Option Explicit
Private Type DataImage
strX As String * 10 'X座標
strY As String * 10 'Y座標
strD As String * 10 '水深
strS As String * 10 '流速
strRt As String * 2 '改行コード
End Type
Public Sub ReadFixdText_3()
'1ブロックのデータ行数(ヘッダ1行+データ50000行)
Const clngRows As Long = 50001
'ブロック数
Const clngBlock As Long = 60
Dim i As Long
Dim j As Long
Dim dfn() As Integer
Dim vntInFile As Variant
Dim dfo As Integer
Dim vntOutFile As Variant
Dim usrFields As DataImage
Dim strPrompt As String
'読み込むファイル名を指定
If Not GetReadFile(vntInFile, ThisWorkbook.Path, False) Then
strPrompt = "マクロがキャンセルされました"
GoTo Wayout
End If
'出力ファイル名を指定
If Not GetWriteFile(vntOutFile, ThisWorkbook.Path) Then
strPrompt = "マクロがキャンセルされました"
GoTo Wayout
End If
If vntInFile = vntOutFile Then
strPrompt = "入力ファイルと出力ファイルに同じ名前は付けられません"
GoTo Wayout
End If
'ファイル番号を格納する配列を確保
ReDim dfn(clngBlock - 1)
'出力ファイルをOutPutモードでOpen
dfo = FreeFile
Open vntOutFile For Output As dfo
'入力ファイルをRandomモードでOpenしヘッダを出力
Print #dfo, "X座標,Y座標,";
For i = 0 To clngBlock - 1
dfn(i) = FreeFile
Open vntInFile For Random Access Read As dfn(i) Len = Len(usrFields)
'ヘッダを取得
Get #dfn(i), i * clngRows + 1, usrFields
'ヘッダを出力（水深、流速両方を出力の場合）
Print #dfo, usrFields.strX; ",,";
'ヘッダを出力
'（水深、流速の片方を出力の場合、上記をコメントアウトし下記を活かす）
' Print #dfo, usrFields.strX; ",";
Next i
Print #dfo, ""
'データを出力
For i = 1 To clngRows - 1
'ブロックの1レコード分取得
Get #dfn(0), , usrFields
With usrFields
'先頭のX座標、Y座標を出力
Print #dfo, Trim(.strX); ","; Trim(.strY);
'水深、流速両方を出力の場合
Print #dfo, ","; Trim(.strD); ","; Trim(.strS);
'水深だけを出力の場合
'（水深、流速の片方を出力の場合、上記をコメントアウトし下記を活かす）
' Print #dfo, ","; Trim(.strD);
'流速だけを出力の場合
' Print #dfo, ","; Trim(.strS);
End With
For j = 1 To clngBlock - 1
'ブロックの1レコード分取得
Get #dfn(j), , usrFields
With usrFields
'水深、流速両方を出力の場合
Print #dfo, ","; Trim(.strD); ","; Trim(.strS);
'水深だけを出力の場合
'（水深、流速の片方を出力の場合、上記をコメントアウトし下記を活かす）
' Print #dfo, ","; Trim(.strD);
'流速だけを出力の場合
' Print #dfo, ","; Trim(.strS);
End With
Next j
Print #dfo, ""
Next i
Close
'確認の為、作成したCSVを開く
If MsgBox("確認の為、作成したCSVを開きますか？", _
vbInformation + vbYesNo) = vbYes Then
Workbooks.Open vntOutFile
End If
strPrompt = "処理が完了しました"
Wayout:
MsgBox strPrompt , vbInformation
End Sub
Private Function GetReadFile(vntFileNames As Variant, _
Optional strFilePath As String, _
Optional blnMultiSel As Boolean _
= False) As Boolean
Dim strFilter As String
'フィルタ文字列を作成
strFilter = "CSV File (*.csv),*.csv," _
& "Text File (*.txt),*.txt," _
& "CSV and Text (*.csv; *.txt),*.csv;*.txt," _
& "全て (*.*),*.*"
'読み込むファイルの有るフォルダを指定
If strFilePath <> "" Then
'ファイルを開くダイアログ表示ホルダに移動
ChDrive Left(strFilePath, 1)
ChDir strFilePath
End If
'もし、ディフォルトのファイル名が有る場合
If vntFileNames <> "" Then
SendKeys vntFileNames & "{TAB}", False
End If
'「ファイルを開く」ダイアログを表示
vntFileNames _
= Application.GetOpenFilename(strFilter, 2, , , blnMultiSel)
If VarType(vntFileNames) = vbBoolean Then
Exit Function
End If
GetReadFile = True
End Function
Private Function GetWriteFile(vntFileName As Variant, _
Optional strFilePath As String) As Boolean
Dim strFilter As String
Dim strInitialFile As String
'フィルタ文字列を作成
strFilter = "CSV File (*.csv),*.csv," _
& "Text File (*.txt),*.txt"
'既定値のファイル名を設定
strInitialFile = vntFileName
'読み込むファイルの有るフォルダを指定
If strFilePath <> "" Then
'ファイルを開くダイアログ表示ホルダに移動
ChDrive Left(strFilePath, 1)
ChDir strFilePath
End If
'「ファイルを保存」ダイアログを表示
vntFileName _
= Application.GetSaveAsFilename(vntFileName, strFilter, 1)
If vntFileName = False Then
Exit Function
End If
GetWriteFile = True
End Function
|
|
Hirofumi
- 09/12/2(水) 17:57 -
