Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


18460 / 76732 ←次へ | 前へ→

【63714】Re:膨大のテキストファイルを読み込みたい
回答  Hirofumi  - 09/12/2(水) 17:57 -

引用なし
パスワード
   >あとは自分のほしい形に直してみます。
もう必要ないのかな?
面白そうなので作って見ました
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

0 hits

【63664】膨大のテキストファイルを読み込みたい 黄身 09/11/28(土) 15:17 質問
【63665】Re:膨大のテキストファイルを読み込みたい 超初心者 09/11/28(土) 15:34 発言
【63666】Re:膨大のテキストファイルを読み込みたい 黄身 09/11/28(土) 16:13 質問
【63667】Re:膨大のテキストファイルを読み込みたい 超初心者 09/11/28(土) 16:57 発言
【63670】Re:膨大のテキストファイルを読み込みたい 黄身 09/11/28(土) 18:50 お礼
【63673】Re:膨大のテキストファイルを読み込みたい kanabun 09/11/28(土) 20:43 質問
【63674】Re:膨大のテキストファイルを読み込みたい 黄身 09/11/29(日) 5:15 発言
【63676】Re:膨大のテキストファイルを読み込みたい よろずや 09/11/29(日) 7:15 発言
【63672】Re:膨大のテキストファイルを読み込みたい Hirofumi 09/11/28(土) 20:23 発言
【63675】Re:膨大のテキストファイルを読み込みたい 黄身 09/11/29(日) 5:42 お礼
【63714】Re:膨大のテキストファイルを読み込みたい Hirofumi 09/12/2(水) 17:57 回答
【63730】Re:膨大のテキストファイルを読み込みたい 黄身 09/12/3(木) 23:27 お礼
【63668】Re:膨大のテキストファイルを読み込みたい よろずや 09/11/28(土) 18:10 発言
【63671】Re:膨大のテキストファイルを読み込みたい 黄身 09/11/28(土) 18:52 お礼

18460 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free