Excel VBA質問箱 IV

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

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


3179 / 13644 ツリー ←次へ | 前へ→

【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 お礼[未読]

【63664】膨大のテキストファイルを読み込みたい
質問  黄身  - 09/11/28(土) 15:17 -

引用なし
パスワード
   Excel初心者です。
今大学の研究で3,000,000行×4列のテキストファイルを、50,000×4列に分けて横に60個並べて読み込もうとしているんですが、どうしたらいいかわかりません。

助言お願いします。

あと2002を使っています。

【63665】Re:膨大のテキストファイルを読み込みたい
発言  超初心者  - 09/11/28(土) 15:34 -

引用なし
パスワード
   ▼黄身 さん:
直接の回答ではありませんが、

こういったところが参考になるかもしれません。
http://www.happy2-island.com/bbs/bbs.cgi?mode=past&no=622

余計なファイルを作成したくないのであれば、
OPEN 〜 # ステートメントで行数をカウントしながら
取込むこともできるかと思います。

ただ、実行速度は分割の方が速いかと・・・・

一連の操作でなくても避ければ、分割は
Vectorのフリーソフトでも見つかるので探してみるのも良いでしょう。


参考までに。

【63666】Re:膨大のテキストファイルを読み込みたい
質問  黄身  - 09/11/28(土) 16:13 -

引用なし
パスワード
   超初心者さんありがとうございました。

このサイトを参考にして一度やってみます。

あともうひとつ質問なんですが、今テキストファイルに、

11903.57 15449.86   .000   .647
11826.67 15412.91   .000  5.266
11764.66 15382.12  2.974  5.266
11705.12 15345.17   .000  5.266

という風に順に並んでいいます。
左から順に、X座標、Y座標、水深、流速なんですが、

X座標が12000<X>15000、かつY座標が17000<Y>19000の範囲の
X座標、Y座標、水深、流速を取り出して並べることは可能ですか?

もしサンプルもあれば教えてください。

【63667】Re:膨大のテキストファイルを読み込みたい
発言  超初心者  - 09/11/28(土) 16:57 -

引用なし
パスワード
   ▼黄身 さん:
エクセルでの処理であれば、一度読み込んでから
フィルターなどで抽出することになるかと思います。

または、OPEN 〜 # ステートメントにて一行ずつ読み込み、
判断をしてOKならセルへ書き込む、
という方法でしょうか。
(先の"分割"が使えなくなりますが^^;)


また、テキストファイルをMSアクセスのテーブルに見立て(?)、
SQLを発行してRecordsetとして取得し、エクセルに取込む、
という方法も良いかもしれません。
http://home.att.ne.jp/zeta/gen/excel/c04p47.htm
MSAccess等を使った事がなければ少し(?)とっつきにくい
かと思いますが、たぶんこちらが最速かと思われます。

【63668】Re:膨大のテキストファイルを読み込みたい
発言  よろずや  - 09/11/28(土) 18:10 -

引用なし
パスワード
   ▼黄身 さん:
>Excel初心者です。
>今大学の研究で3,000,000行×4列のテキストファイルを、50,000×4列に分けて横に60個並べて読み込もうとしているんですが、どうしたらいいかわかりません。
>

いくらなんでも膨大すぎます。

やってみて結局ダメだったってことになるのが落ちだと思いますよ。

データベースソフトの使用を強くお奨めします。

Excelをデータベースとして使うという方法がよく紹介されてますが、
安定して扱えるデータ量がまるで違います。

【63670】Re:膨大のテキストファイルを読み込みたい
お礼  黄身  - 09/11/28(土) 18:50 -

引用なし
パスワード
   ▼超初心者 さん:
先の分割を利用したほうが効率が良さそうなのでそれで続けてみます。

また何かあればよろしくお願いします。
本当にありがとうございました!!

>▼黄身 さん:
>エクセルでの処理であれば、一度読み込んでから
>フィルターなどで抽出することになるかと思います。
>
>または、OPEN 〜 # ステートメントにて一行ずつ読み込み、
>判断をしてOKならセルへ書き込む、
>という方法でしょうか。
>(先の"分割"が使えなくなりますが^^;)
>
>
>また、テキストファイルをMSアクセスのテーブルに見立て(?)、
>SQLを発行してRecordsetとして取得し、エクセルに取込む、
>という方法も良いかもしれません。
>http://home.att.ne.jp/zeta/gen/excel/c04p47.htm
>MSAccess等を使った事がなければ少し(?)とっつきにくい
>かと思いますが、たぶんこちらが最速かと思われます。

【63671】Re:膨大のテキストファイルを読み込みたい
お礼  黄身  - 09/11/28(土) 18:52 -

引用なし
パスワード
   やはりきびしいのでしょうか?
とりあえずやってみるよう頼まれたので一度やってみます。

助言ありがとうございます!

▼よろずや さん:
>▼黄身 さん:
>>Excel初心者です。
>>今大学の研究で3,000,000行×4列のテキストファイルを、50,000×4列に分けて横に60個並べて読み込もうとしているんですが、どうしたらいいかわかりません。
>>
>
>いくらなんでも膨大すぎます。
>
>やってみて結局ダメだったってことになるのが落ちだと思いますよ。
>
>データベースソフトの使用を強くお奨めします。
>
>Excelをデータベースとして使うという方法がよく紹介されてますが、
>安定して扱えるデータ量がまるで違います。

【63672】Re:膨大のテキストファイルを読み込みたい
発言  Hirofumi  - 09/11/28(土) 20:23 -

引用なし
パスワード
   >Excel初心者です。
>今大学の研究で3,000,000行×4列のテキストファイルを、50,000×4列に分けて横に60個並べて読み込もうとしているんですが、どうしたらいいかわかりません。
>
>助言お願いします。
>
>あと2002を使っています。

如何しても、やって見るなら
Csvで4列×3,000,000行で下記の様なデータ

11903.57 15449.86   .000   .647
11826.67 15412.91   .000  5.266
11764.66 15382.12  2.974  5.266
11705.12 15345.17   .000  5.266

なら、時間が掛かりますが何とか行けるかも?
Vista 2.3G メモリ2G Excel2007で約60秒ぐらいかな?

Option Explicit

Public Sub ReadCsvExt()

'  指定行数分出力版(データ抽出)

  '出力行数のサイズを設定
  Const clngOutputSize = 50000

  Dim lngWrite As Long
  Dim lngRow As Long
  Dim lngColumn As Long
  Dim lngColumns As Long
  Dim rngResult As Range
  Dim vntResult() As Variant
  Dim vntFilename As Variant
  Dim dfn As Integer
  Dim strBuff As String
  Dim strRec As String
  Dim blnMulti As Boolean
  Dim strPrompt As String
  
  Dim sngTime1 As Single
  Dim sngTime2 As Single
  
  '結果用配列の列初期値を設定
  lngColumns = 3
  
  If Not GetReadFile(vntFilename, ThisWorkbook.Path) Then
    strPrompt = "マクロがキャンセルされました"
    GoTo Wayout
  End If
  
  sngTime2 = Timer
  
  '結果出力位置の指定
  Set rngResult = ActiveSheet.Range("A1")
  
  '画面更新を停止
  Application.ScreenUpdating = False
  
  '空きファイルバファ番号を取得
  dfn = FreeFile
  'ファイルをInputモードでOpen
  Open vntFilename For Input As dfn
  
  ReDim vntResult(1 To clngOutputSize, lngColumns)
  Do Until EOF(dfn)
    'ファイルより、1行読み込み
    Line Input #dfn, strBuff
    '論理レコードに物理レコードを追加
    strRec = strRec & strBuff
    '出力用配列を作成
    lngRow = lngRow + 1
    SplitCsv strRec, vntResult, lngRow, lngColumns, vbCrLf, blnMulti
    If blnMulti Then
      lngRow = lngRow - 1
      strRec = strRec & vbLf
    Else
      strRec = ""
      '★抽出条件(抽出の場合以下のコメントアウトを活かす)
'      If (Val(vntResult(lngRow, 0)) <= 12000 _
'          Or 15000 <= Val(vntResult(lngRow, 0))) _
'              Or (Val(vntResult(lngRow, 1)) <= 17000 _
'                  Or 19000 <= Val(vntResult(lngRow, 1))) Then
'        lngRow = lngRow - 1
'      End If
    End If
    If lngRow = clngOutputSize Then
      '結果をシートに出力
      rngResult.Offset(lngWrite, lngColumn).Resize(lngRow, _
            lngColumns + 1).Value = vntResult
      lngColumn = lngColumn + 4
      lngRow = 0
    End If
  Loop
  
  'ファイルを閉じる
  Close #dfn
    
  '文字列バファにデータが残っている場合、配列に出力
  If lngRow > 0 Then
    '結果をシートに出力
    rngResult.Offset(lngWrite, lngColumn).Resize(lngRow, lngColumns + 1).Value = vntResult
  End If

  strPrompt = "処理が完了しました"
  
Wayout:

  '画面更新を再開
  Application.ScreenUpdating = True
  
  Set rngResult = Nothing
  
  sngTime1 = Timer
  
  MsgBox strPrompt & vbLf & (sngTime1 - sngTime2), vbInformation
  
End Sub

Private Sub SplitCsv(strLine As String, _
            vntData() As Variant, _
            lngRow As Long, _
            lngColumns As Long, _
            strRet As String, _
            Optional blnMulti As Boolean)

  Const strDelimiter As String = ","
  Const strQuote As String = """"
  
  Dim i As Long
  Dim lngDPos As Long
  Dim lngStart As Long
  Dim lngEnd As Long
  Dim strField As String
  Dim lngRowMax As Long
  Dim strTmp As String
  
  lngRowMax = UBound(vntData, 1)
  
  '配列の添え字の初期値
  i = 0
  'Delimiter探索の開始位置
  lngStart = 1
  '分割元の文字列の長さ
  lngEnd = Len(strLine)
  '複数行Flagを初期化
  blnMulti = False
  '探索開始位置が分割元の文字列の長さを超えるまで分割
  Do
    'もし、開始位置の文字がstrQuoteと違う場合
    If Mid$(strLine, lngStart, 1) <> strQuote Then
      'Delimiterの位置を取得
      lngDPos = InStr(lngStart, strLine, strDelimiter, vbBinaryCompare)
      'Delimiterがある場合
      If lngDPos > 0 Then
        '開始位置からDelimiterの前までを取得
        strField = Mid$(strLine, lngStart, lngDPos - lngStart)
        '開始位置をDelimiterの後ろに更新
        lngStart = lngDPos + 1
      Else
        '開始位置以降を取得
        strField = Mid$(strLine, lngStart)
        '開始位置を分割元の文字列の長さを超える位置に
        lngStart = lngEnd + 1
      End If
    '開始位置の文字がstrQuoteと同じ場合
    Else
      '開始位置をstrQuoteの後ろに設定
      lngStart = lngStart + 1
      Do
        'strQuoteの位置を取得
        lngDPos = InStr(lngStart, strLine, strQuote, vbBinaryCompare)
        'strQuoteがある場合
        If lngDPos > 0 Then
          '取得済みの文字列にstrQuote以降の文字列を加算
          strField = strField & Mid$(strLine, lngStart, lngDPos - lngStart)
          '開始位置をstrQuote以降に更新
          lngStart = lngDPos + 1
          '分割元の文字列の開始位置から1文字取得し
          strTmp = Mid$(strLine, lngStart, 1)
          'Delimiterなら
          If strTmp = strDelimiter Then
            '開始位置を1つ進める
            lngStart = lngStart + 1
            'Doを抜ける
            Exit Do
          '空白の文字列なら
          ElseIf strTmp = "" Then
            'Doを抜ける
            Exit Do
          'strQuoteなら
          ElseIf strTmp = strQuote Then
            '開始位置を1つ進める
            lngStart = lngStart + 1
            '取得済みの文字列にstrQuoteを加算
            strField = strField & strQuote
          End If
        'strQuoteが無い場合
        Else
          '複数行Flagを立てる
          blnMulti = True
          strField = Mid$(strLine, lngStart) & strRet
          '開始位置を分割元の文字列の長さを超える位置に
          lngStart = lngEnd + 1
          'Doを抜ける
          Exit Do
        End If
      Loop
    End If
    '配列を確保
    If i > lngColumns Then
      lngColumns = lngColumns + 1
      ReDim Preserve vntData(1 To lngRowMax, lngColumns)
    End If
    '配列に取得文字列を代入
    vntData(lngRow, i) = strField
    '取得文字列を初期化
    strField = ""
    '配列の添え字を更新
    i = i + 1
  Loop Until lngEnd < lngStart
  
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, 1, , , blnMultiSel)
  If VarType(vntFileNames) = vbBoolean Then
    Exit Function
  End If
  
  GetReadFile = True
  
End Function

【63673】Re:膨大のテキストファイルを読み込みたい
質問  kanabun  - 09/11/28(土) 20:43 -

引用なし
パスワード
   ▼黄身 さん:
よこから失礼

すでにアドバイスがありますが、データベース風に抽出しないのなら
基本的には Line Input#ステートメントで読むことになると思います。

ちなみに、

>テキストファイルに、
>
> 11903.57 15449.86   .000   .647
> 11826.67 15412.91   .000  5.266
> 11764.66 15382.12  2.974  5.266
> 11705.12 15345.17   .000  5.266
>
>という風に順に並んでいいます。

テキストの形式は 固定バイト長ですか?
それとも TABコードとかで区切られたテキストですか?

【63674】Re:膨大のテキストファイルを読み込みたい
発言  黄身  - 09/11/29(日) 5:15 -

引用なし
パスワード
   ▼kanabun さん:

テキストの形式は 固定バイト長だと思います。

データベース風というのがよくわからないんですが、
このテキストファイルをExcelに直したら、KK-MASというソフトに外部入力
するつもりです。
形式はcsvです。

あとテキストファイルを見ててわかったことがあって、
3,000,000行×4列なんですが、

TIME=1
11903.57 15449.86   .000   .647
11826.67 15412.91   .000  5.266
11764.66 15382.12  2.974  5.266
11705.12 15345.17   .000  5.266
  ・   ・    ・    ・
  ・   ・    ・    ・
  ・   ・    ・    ・
TIME=2
11903.57 15449.86   .234   .847
11826.67 15412.91   .237  5.386
11764.66 15382.12  3.274  5.386
11705.12 15345.17   .620  5.386
  ・   ・    ・    ・
  ・   ・    ・    ・
  ・   ・    ・    ・
という風に50,000行×4列が縦に60個連続で並んでいるようです。
左2つはTIME=1とTIME=2で同じ数値が繰り返されています。
右2つはTIME=1とTIME=2で数値が変化しています。
左から順にX座標、Y座標、水深、流速を表しています。


今更なんですけど、やろうとしていることは、
ある座標点(X座標,Y座標)の時間経過における水深と流速の変化を
調べようとしています。
とりあえず今は流速だけでいいんで、

最終的なcsvファイルの形としては、

X座標  Y座標   TIME=1  TIME=2 ・・・(TIMEは60まで)
11903.57 15449.86   .000   .234 ・・・
11826.67 15412.91   .000   .237 ・・・
11764.66 15382.12  2.974  3.274 ・・・
11705.12 15345.17   .000   .620 ・・・
  ・   ・    ・    ・   ・
  ・   ・    ・    ・   ・
  ・   ・    ・    ・   ・
           ↑    ↑  ↑
           (これらは水深です)

みたいに並べたいです。
説明下手でわかりにくいかもしれませんが、これを踏まえて
アドバイスお願いします!


>▼黄身 さん:
>よこから失礼
>
>すでにアドバイスがありますが、データベース風に抽出しないのなら
>基本的には Line Input#ステートメントで読むことになると思います。
>
>ちなみに、
>
>>テキストファイルに、
>>
>> 11903.57 15449.86   .000   .647
>> 11826.67 15412.91   .000  5.266
>> 11764.66 15382.12  2.974  5.266
>> 11705.12 15345.17   .000  5.266
>>
>>という風に順に並んでいいます。
>
>テキストの形式は 固定バイト長ですか?
>それとも TABコードとかで区切られたテキストですか?

【63675】Re:膨大のテキストファイルを読み込みたい
お礼  黄身  - 09/11/29(日) 5:42 -

引用なし
パスワード
   ▼Hirofumi さん:
天才ですね!!!!!

あとは自分のほしい形に直してみます。

また壁にぶちあたったらコメントお願いします。

ありがとうございました!


>>Excel初心者です。
>>今大学の研究で3,000,000行×4列のテキストファイルを、50,000×4列に分けて横に60個並べて読み込もうとしているんですが、どうしたらいいかわかりません。
>>
>>助言お願いします。
>>
>>あと2002を使っています。
>
>如何しても、やって見るなら
>Csvで4列×3,000,000行で下記の様なデータ
>
>11903.57 15449.86   .000   .647
>11826.67 15412.91   .000  5.266
>11764.66 15382.12  2.974  5.266
>11705.12 15345.17   .000  5.266
>
>なら、時間が掛かりますが何とか行けるかも?
>Vista 2.3G メモリ2G Excel2007で約60秒ぐらいかな?
>
>Option Explicit
>
>Public Sub ReadCsvExt()
>
>'  指定行数分出力版(データ抽出)
>
>  '出力行数のサイズを設定
>  Const clngOutputSize = 50000
>
>  Dim lngWrite As Long
>  Dim lngRow As Long
>  Dim lngColumn As Long
>  Dim lngColumns As Long
>  Dim rngResult As Range
>  Dim vntResult() As Variant
>  Dim vntFilename As Variant
>  Dim dfn As Integer
>  Dim strBuff As String
>  Dim strRec As String
>  Dim blnMulti As Boolean
>  Dim strPrompt As String
>  
>  Dim sngTime1 As Single
>  Dim sngTime2 As Single
>  
>  '結果用配列の列初期値を設定
>  lngColumns = 3
>  
>  If Not GetReadFile(vntFilename, ThisWorkbook.Path) Then
>    strPrompt = "マクロがキャンセルされました"
>    GoTo Wayout
>  End If
>  
>  sngTime2 = Timer
>  
>  '結果出力位置の指定
>  Set rngResult = ActiveSheet.Range("A1")
>  
>  '画面更新を停止
>  Application.ScreenUpdating = False
>  
>  '空きファイルバファ番号を取得
>  dfn = FreeFile
>  'ファイルをInputモードでOpen
>  Open vntFilename For Input As dfn
>  
>  ReDim vntResult(1 To clngOutputSize, lngColumns)
>  Do Until EOF(dfn)
>    'ファイルより、1行読み込み
>    Line Input #dfn, strBuff
>    '論理レコードに物理レコードを追加
>    strRec = strRec & strBuff
>    '出力用配列を作成
>    lngRow = lngRow + 1
>    SplitCsv strRec, vntResult, lngRow, lngColumns, vbCrLf, blnMulti
>    If blnMulti Then
>      lngRow = lngRow - 1
>      strRec = strRec & vbLf
>    Else
>      strRec = ""
>      '★抽出条件(抽出の場合以下のコメントアウトを活かす)
>'      If (Val(vntResult(lngRow, 0)) <= 12000 _
>'          Or 15000 <= Val(vntResult(lngRow, 0))) _
>'              Or (Val(vntResult(lngRow, 1)) <= 17000 _
>'                  Or 19000 <= Val(vntResult(lngRow, 1))) Then
>'        lngRow = lngRow - 1
>'      End If
>    End If
>    If lngRow = clngOutputSize Then
>      '結果をシートに出力
>      rngResult.Offset(lngWrite, lngColumn).Resize(lngRow, _
>            lngColumns + 1).Value = vntResult
>      lngColumn = lngColumn + 4
>      lngRow = 0
>    End If
>  Loop
>  
>  'ファイルを閉じる
>  Close #dfn
>    
>  '文字列バファにデータが残っている場合、配列に出力
>  If lngRow > 0 Then
>    '結果をシートに出力
>    rngResult.Offset(lngWrite, lngColumn).Resize(lngRow, lngColumns + 1).Value = vntResult
>  End If
>
>  strPrompt = "処理が完了しました"
>  
>Wayout:
>
>  '画面更新を再開
>  Application.ScreenUpdating = True
>  
>  Set rngResult = Nothing
>  
>  sngTime1 = Timer
>  
>  MsgBox strPrompt & vbLf & (sngTime1 - sngTime2), vbInformation
>  
>End Sub
>
>Private Sub SplitCsv(strLine As String, _
>            vntData() As Variant, _
>            lngRow As Long, _
>            lngColumns As Long, _
>            strRet As String, _
>            Optional blnMulti As Boolean)
>
>  Const strDelimiter As String = ","
>  Const strQuote As String = """"
>  
>  Dim i As Long
>  Dim lngDPos As Long
>  Dim lngStart As Long
>  Dim lngEnd As Long
>  Dim strField As String
>  Dim lngRowMax As Long
>  Dim strTmp As String
>  
>  lngRowMax = UBound(vntData, 1)
>  
>  '配列の添え字の初期値
>  i = 0
>  'Delimiter探索の開始位置
>  lngStart = 1
>  '分割元の文字列の長さ
>  lngEnd = Len(strLine)
>  '複数行Flagを初期化
>  blnMulti = False
>  '探索開始位置が分割元の文字列の長さを超えるまで分割
>  Do
>    'もし、開始位置の文字がstrQuoteと違う場合
>    If Mid$(strLine, lngStart, 1) <> strQuote Then
>      'Delimiterの位置を取得
>      lngDPos = InStr(lngStart, strLine, strDelimiter, vbBinaryCompare)
>      'Delimiterがある場合
>      If lngDPos > 0 Then
>        '開始位置からDelimiterの前までを取得
>        strField = Mid$(strLine, lngStart, lngDPos - lngStart)
>        '開始位置をDelimiterの後ろに更新
>        lngStart = lngDPos + 1
>      Else
>        '開始位置以降を取得
>        strField = Mid$(strLine, lngStart)
>        '開始位置を分割元の文字列の長さを超える位置に
>        lngStart = lngEnd + 1
>      End If
>    '開始位置の文字がstrQuoteと同じ場合
>    Else
>      '開始位置をstrQuoteの後ろに設定
>      lngStart = lngStart + 1
>      Do
>        'strQuoteの位置を取得
>        lngDPos = InStr(lngStart, strLine, strQuote, vbBinaryCompare)
>        'strQuoteがある場合
>        If lngDPos > 0 Then
>          '取得済みの文字列にstrQuote以降の文字列を加算
>          strField = strField & Mid$(strLine, lngStart, lngDPos - lngStart)
>          '開始位置をstrQuote以降に更新
>          lngStart = lngDPos + 1
>          '分割元の文字列の開始位置から1文字取得し
>          strTmp = Mid$(strLine, lngStart, 1)
>          'Delimiterなら
>          If strTmp = strDelimiter Then
>            '開始位置を1つ進める
>            lngStart = lngStart + 1
>            'Doを抜ける
>            Exit Do
>          '空白の文字列なら
>          ElseIf strTmp = "" Then
>            'Doを抜ける
>            Exit Do
>          'strQuoteなら
>          ElseIf strTmp = strQuote Then
>            '開始位置を1つ進める
>            lngStart = lngStart + 1
>            '取得済みの文字列にstrQuoteを加算
>            strField = strField & strQuote
>          End If
>        'strQuoteが無い場合
>        Else
>          '複数行Flagを立てる
>          blnMulti = True
>          strField = Mid$(strLine, lngStart) & strRet
>          '開始位置を分割元の文字列の長さを超える位置に
>          lngStart = lngEnd + 1
>          'Doを抜ける
>          Exit Do
>        End If
>      Loop
>    End If
>    '配列を確保
>    If i > lngColumns Then
>      lngColumns = lngColumns + 1
>      ReDim Preserve vntData(1 To lngRowMax, lngColumns)
>    End If
>    '配列に取得文字列を代入
>    vntData(lngRow, i) = strField
>    '取得文字列を初期化
>    strField = ""
>    '配列の添え字を更新
>    i = i + 1
>  Loop Until lngEnd < lngStart
>  
>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, 1, , , blnMultiSel)
>  If VarType(vntFileNames) = vbBoolean Then
>    Exit Function
>  End If
>  
>  GetReadFile = True
>  
>End Function

【63676】Re:膨大のテキストファイルを読み込みたい
発言  よろずや  - 09/11/29(日) 7:15 -

引用なし
パスワード
   エクセルに読み込みたいというよりは、テキスト→テキスト変換なのですね。
そういうことなら話は別です。
縦:50000×横:62 ですからそれほどでもないし、
エクセル上で何かしたいという話でもなし。
エクセルを使うというよりは、手軽なプログラミング環境として
VBAを使うということで問題ないと思います。
がんばってください。

>あとテキストファイルを見ててわかったことがあって、
>3,000,000行×4列なんですが、
>
>TIME=1
>11903.57 15449.86   .000   .647
>11826.67 15412.91   .000  5.266
>11764.66 15382.12  2.974  5.266
>11705.12 15345.17   .000  5.266
>  ・   ・    ・    ・
>  ・   ・    ・    ・
>  ・   ・    ・    ・
>TIME=2
>11903.57 15449.86   .234   .847
>11826.67 15412.91   .237  5.386
>11764.66 15382.12  3.274  5.386
>11705.12 15345.17   .620  5.386
>  ・   ・    ・    ・
>  ・   ・    ・    ・
>  ・   ・    ・    ・
>という風に50,000行×4列が縦に60個連続で並んでいるようです。
>左2つはTIME=1とTIME=2で同じ数値が繰り返されています。
>右2つはTIME=1とTIME=2で数値が変化しています。
>左から順にX座標、Y座標、水深、流速を表しています。
>
>
>今更なんですけど、やろうとしていることは、
>ある座標点(X座標,Y座標)の時間経過における水深と流速の変化を
>調べようとしています。
>とりあえず今は流速だけでいいんで、
>
>最終的なcsvファイルの形としては、
>
>X座標  Y座標   TIME=1  TIME=2 ・・・(TIMEは60まで)
>11903.57 15449.86   .000   .234 ・・・
>11826.67 15412.91   .000   .237 ・・・
>11764.66 15382.12  2.974  3.274 ・・・
>11705.12 15345.17   .000   .620 ・・・
>  ・   ・    ・    ・   ・
>  ・   ・    ・    ・   ・
>  ・   ・    ・    ・   ・
>           ↑    ↑  ↑
>           (これらは水深です)
>
>みたいに並べたいです。
>説明下手でわかりにくいかもしれませんが、これを踏まえて
>アドバイスお願いします!

【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

【63730】Re:膨大のテキストファイルを読み込みたい
お礼  黄身  - 09/12/3(木) 23:27 -

引用なし
パスワード
   ▼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

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