Excel VBA質問箱 IV

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

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


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

【23101】65536行を超えるテキストデータの抽出 わた(初心者) 05/3/13(日) 13:41 質問[未読]
【23103】Re:65536行を超えるテキストデータの抽出 Hirofumi 05/3/13(日) 18:02 回答[未読]
【23108】Re:65536行を超えるテキストデータの抽出 わた(初心者) 05/3/13(日) 20:42 質問[未読]
【23109】Re:65536行を超えるテキストデータの抽出 Hirofumi 05/3/13(日) 21:20 回答[未読]
【23110】Re:65536行を超えるテキストデータの抽出 かみちゃん 05/3/13(日) 21:26 回答[未読]
【23111】Re:65536行を超えるテキストデータの抽出 わた(初心者) 05/3/13(日) 22:31 お礼[未読]
【23112】Re:65536行を超えるテキストデータの抽出 わた(初心者) 05/3/13(日) 22:34 お礼[未読]

【23101】65536行を超えるテキストデータの抽出
質問  わた(初心者) E-MAIL  - 05/3/13(日) 13:41 -

引用なし
パスワード
   テキストファイルaaa.txtのデータをエクセルにインポートしたいのですが
65536行を超えているため、必要なデータ行を抜き取りたいと考えています。
自動記録だけでは対応できないので、良い対策を教えて下さい。

テキストファイルaaa.txtはこのようなつくりだとします
 ~aaa.txt~
 りんご 5 200
 みかん 4 300
 いちご 2 350
  ・
  ・(順不同で65336行を超えています)

エクセルにこのまま全てを読み込ませることは無理なので、
例えば"みかん"行だけ取り入れるにはどうすれば良いでしょう?

【23103】Re:65536行を超えるテキストデータの抽出
回答  Hirofumi  - 05/3/13(日) 18:02 -

引用なし
パスワード
   例えばこんなかな?
区切りが、Tabか、カンマか、わから無いのでTabにして有ります
また、ファイルの先頭フィールドから抽出しています

Option Explicit
Option Compare Text

Public Sub DataRead()

  Dim i As Long
  Dim vntFileName As Variant
  Dim lngRow As Long
  Dim lngCol As Long
  Dim wksResult As Worksheet
  
  '読み込むファイルを取得
  If Not GetReadFile(vntFileName, ThisWorkbook.Path) Then
    Exit Sub
  End If
  
  Application.ScreenUpdating = False
  
  '書き込み行初期値
  lngRow = 1
  '書き込み列初期値
  lngCol = 1
  '読み込むシートを設定
  Set wksResult = ActiveSheet
  
  'データの読み込み(Tab区切り)
  CSVRead vntFileName, wksResult, lngRow, lngCol, vbTab
  'データの読み込み(カンマ区切り)
'  CSVRead vntFileName, wksResult, lngRow, lngCol, ","
  
  Set wksResult = Nothing
  
  Application.ScreenUpdating = True
  
  Beep
  MsgBox "処理が完了しました"
  
End Sub

Private Sub CSVRead(ByVal strFileName As String, _
              ByVal wksWrite As Worksheet, _
              Optional ByRef lngRow As Long = 1, _
              Optional ByRef lngCol As Long = 1, _
              Optional strDelim As String = ",")
  
  Dim dfn As Integer
  Dim vntField As Variant
  Dim strLine As String
  Dim blnMulti As Boolean
  Dim strRec As String
  
  'ファイルをOpen
  dfn = FreeFile
  Open strFileName For Input As dfn
  
  Do Until EOF(dfn)
    '1行読み込み
    Line Input #dfn, strLine
    strRec = strRec & strLine
    vntField = SplitCsv(strRec, strDelim, , , blnMulti)
    'フィールド内で改行が有る場合
    If blnMulti Then
      '改行が有った場合、セル内改行として残す
      strRec = strRec & vbLf
    Else
      '先頭フィールドの値が、"みかん"の時
      If vntField(0) = "みかん" Then
        With wksWrite.Cells(lngRow, lngCol)
          With .Resize(, UBound(vntField) + 1)
            '出力範囲を文字列に設定
'            .NumberFormat = "@"
            'データを出力
            .Value = vntField
          End With
        End With
        '出力行をインクリメント
        lngRow = lngRow + 1
      End If
      strRec = ""
    End If
  Loop
  
  Close #dfn
  
End Sub

Public Function SplitCsv(ByVal strLine As String, _
            Optional strDelimiter As String = ",", _
            Optional strQuote As String = """", _
            Optional strRet As String = vbCrLf, _
            Optional blnMulti As Boolean) As Variant

  Dim lngDPos As Long
  Dim vntData() As Variant
  Dim lngStart As Long
  Dim i As Long
  Dim vntField As Variant
  Dim lngLength As Long
  
  i = 0
  lngStart = 1
  lngLength = Len(strLine)
  blnMulti = False
  Do
    ReDim Preserve vntData(i)
    If Mid$(strLine, lngStart, 1) <> strQuote Then
      lngDPos = InStr(lngStart, strLine, _
            strDelimiter, vbBinaryCompare)
      If lngDPos > 0 Then
        vntField = Mid$(strLine, lngStart, _
                  lngDPos - lngStart)
        If lngDPos = lngLength Then
          ReDim Preserve vntData(i + 1)
        End If
        lngStart = lngDPos + 1
      Else
        vntField = Mid$(strLine, lngStart)
        lngStart = lngLength + 1
      End If
    Else
      lngStart = lngStart + 1
      Do
        lngDPos = InStr(lngStart, strLine, _
                strQuote, vbBinaryCompare)
        If lngDPos > 0 Then
          vntField = vntField & Mid$(strLine, _
                lngStart, lngDPos - lngStart)
          lngStart = lngDPos + 1
          Select Case Mid$(strLine, lngStart, 1)
            Case ""
              Exit Do
            Case strDelimiter
              lngStart = lngStart + 1
              Exit Do
            Case strQuote
              lngStart = lngStart + 1
              vntField = vntField & strQuote
          End Select
        Else
          blnMulti = True
          vntField = Mid$(strLine, lngStart) & strRet
          lngStart = lngLength + 1
          Exit Do
        End If
      Loop
    End If
    vntData(i) = vntField
    vntField = Empty
    i = i + 1
  Loop Until lngLength < lngStart
  
  SplitCsv = vntData()
  
End Function

Public 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

【23108】Re:65536行を超えるテキストデータの抽出
質問  わた(初心者) E-MAIL  - 05/3/13(日) 20:42 -

引用なし
パスワード
   Hirofumi さん、ありがとう御座います。
(早いですね!)
参考にさせて頂きます。

ちなみにファイルがスペース区切りの時はどの辺りが
変わるのでしょう?

また今後も外部データ取り込みの処理について勉強したい
のですが、お勧めの本はありますか?

【23109】Re:65536行を超えるテキストデータの抽出
回答  Hirofumi  - 05/3/13(日) 21:20 -

引用なし
パスワード
   >ちなみにファイルがスペース区切りの時はどの辺りが
>変わるのでしょう?

本当にスペース区切りですか?
このコードでは、スペース1個(全角若しくは半角)で区切られている場合なら
以下を、修正すれば対応します
しかし、偶に固定長フィールドのファイルをスペースで区切られていると
勘違いされている場合が有りますので、其処を善く確認して下さい
固定長フィールドの場合、全く別の読み方をします

  'データの読み込み(スペース区切り)
  CSVRead vntFileName, wksResult, lngRow, lngCol, " "

固定長フィールド:
レコードの各フィールド長が、決められたByte数の文字で構成されているファイル?

>また今後も外部データ取り込みの処理について勉強したい
>のですが、お勧めの本はありますか?

私の場合、これと言った本で外部データ取り込みの処理について勉強した事が有りませんので
申し訳有りませんが、回答できません

【23110】Re:65536行を超えるテキストデータの抽出
回答  かみちゃん  - 05/3/13(日) 21:26 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>ちなみにファイルがスペース区切りの時はどの辺りが
>変わるのでしょう?

  'データの読み込み(Tab区切り)
  CSVRead vntFileName, wksResult, lngRow, lngCol, vbTab
  'データの読み込み(カンマ区切り)
'  CSVRead vntFileName, wksResult, lngRow, lngCol, ","

というコードがありますので、
  'データの読み込み(スペース区切り)
  CSVRead vntFileName, wksResult, lngRow, lngCol, " "
でいいのではないでしょうか?

>また今後も外部データ取り込みの処理について勉強したい
>のですが、お勧めの本はありますか?

おすすめの本ではないですが、
Accessをお持ちでしたら、Accessのテーブルにデータをインポートしておいて、
Excelで必要なデータを抽出してくるということもできるかと思います。
そのほうがコードも短くなっていいかもしれません。

【23111】Re:65536行を超えるテキストデータの抽出
お礼  わた(初心者) E-MAIL  - 05/3/13(日) 22:31 -

引用なし
パスワード
   かみちゃん さん

もろもろ対応頂き、有難う御座います!!!。

外部データの取り込みは本に載っていなかった
ので本当に困ってました。
データ取り込み時の参考にしたいと思います。

苦手な条件判断を少し取り入れることにより
(私でも)良いものが作れるかもしれません。

以上です。

【23112】Re:65536行を超えるテキストデータの抽出
お礼  わた(初心者) E-MAIL  - 05/3/13(日) 22:34 -

引用なし
パスワード
   hirofumiさん

構文を作成して頂き有難う御座います!!!。
この回答を参考に研究したいと思います。

以上です。

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