| |
▼Hirofumi さん：
遅くなってすみません。
何度か手直しするつもりなんで全然必要なくありませんよ！！
ありがたく試さしてもらいます！
感謝します！！
>>あとは自分のほしい形に直してみます。
>もう必要ないのかな？
>面白そうなので作って見ました
>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
|
|
黄身
- 09/12/3(木) 23:27 -
