Excel VBA質問箱 IV

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

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


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

【6505】テキストデータからの抽出 いわまる 03/7/4(金) 18:17 質問
【6507】Re:テキストデータからの抽出 Hirofumi 03/7/4(金) 20:49 回答
【6534】Re:テキストデータからの抽出 いわまる 03/7/7(月) 18:43 質問
【6539】Re:テキストデータからの抽出 Hirofumi 03/7/7(月) 21:11 発言
【6543】Re:テキストデータからの抽出 いわまる 03/7/8(火) 9:06 お礼

【6505】テキストデータからの抽出
質問  いわまる  - 03/7/4(金) 18:17 -

引用なし
パスワード
   はじめまして、最近VBAを使うようになったのですが、
先輩からの宿題で、以下のようなマクロを作成しなくてはなりません。

膨大な量のテキストデータ(ファイルは1つですが)を読み込み、その中にある、

CO_英数半角(文字数不定)_数字_数字_数字
(アンダーバーはスペースです)

という行を抜き出し、スペースにはさまれている文字(数字)を
各セルに挿入しするというものです。
(たくさんあるデータから、文頭が「CO」と書かれた行を抜き出す作業です)

こういった行は複数あり、テキストの1行目から順番にペーストできればと
考えています。

すべてのテキストデータをシートに入れて不要な部分を削除すればいいかと
思っていたのですが、シート上に収まらないため、頭を抱えています。

自分自身混乱しているので、わかりにくい表現になっていると思いますが,
もし、よろしければご教授ください。

よろしくお願いします。

【6507】Re:テキストデータからの抽出
回答  Hirofumi E-MAIL  - 03/7/4(金) 20:49 -

引用なし
パスワード
   こんなで善いのかな?
当方Excel97なので、Split関数がない為、その部分も作って居ますが
Excel2000以上なら、以下部分をSplit関数にした方が善いと思います
      '1行の4文字目以降をフィールドに分割
      vntField = Split97(Mid(strBuff, 4), " ")

      '1行の4文字目以降をフィールドに分割
      vntField = Split(Mid(strBuff, 4), " ")
に変更
その場合、Function Split97はいりません

Public Sub TextRead()

  Dim dfn As Integer
  Dim vntFileName As Variant
  Dim strFileFilter As String
  Dim strBuff As String
  Dim vntField As Variant
  Dim lngWriteRow As Long
  
  '「ファイルを開く」ダイアログを表示
  strFileFilter = "TextFile (*.txt),*.txt,CsvFile (*.csv),*.csv"
  vntFileName = Application.GetOpenFilename(strFileFilter, 1)
  'もし、キャンセルされた場合Subを抜ける
  If vntFileName = False Then
    Exit Sub
  End If
  
'  Application.ScreenUpdating = False
  
  'ファイルバッファ番号を取得
  dfn = FreeFile
  'ファイルをInputモードで開く
  Open vntFileName For Input As dfn
  
  '書き込み行の初期値を設定
  lngWriteRow = 1
  'ファイルエンドまで繰り返し
  Do Until EOF(dfn)
    'ファイルから1行読み込み
    Line Input #dfn, strBuff
    '行の先頭2文字がCOで有るならば
    If StrComp(Left(strBuff, 2), _
            "CO", vbTextCompare) = 0 Then
      '1行の4文字目以降をフィールドに分割
      vntField = Split97(Mid(strBuff, 4), " ")
      'アクティブシートの書き込み行、1列を指定
      With Cells(lngWriteRow, 1)
        'データの書き込み
        Range(.Offset(, 0), _
            .Offset(, UBound(vntField))).Value _
                            = vntField
      End With
      '書き込み行を更新
      lngWriteRow = lngWriteRow + 1
    End If
  Loop
  
  'ファイルを閉じる
  Close #dfn
  
'  Application.ScreenUpdating = True
  
End Sub

Public Function Split97(ByVal vntValue As Variant, _
            Optional ByVal strDelimiter As String = ",", _
            Optional ByVal intCompare As Integer _
                      = vbBinaryCompare) As Variant

  Dim i As Long
  Dim vntData() As Variant
  Dim lngPos As Long
  Dim intDelLen As Integer
  
  If intCompare <> vbBinaryCompare Then
    intCompare = vbTextCompare
  End If
  If strDelimiter = "" Then
    ReDim vntData(0)
    vntData(0) = vntValue
    Split97 = vntData
    Exit Function
  End If
  If vntValue = "" Then
    Split97 = ""
    Exit Function
  End If
  intDelLen = Len(strDelimiter)
  
  i = 0
  ReDim vntData(i)
  lngPos = InStr(1, vntValue, strDelimiter, intCompare)
  Do Until lngPos = 0
    vntData(i) = Left(vntValue, lngPos - 1)
    vntValue = Mid(vntValue, lngPos + intDelLen)
    i = i + 1
    ReDim Preserve vntData(i)
    lngPos = InStr(1, vntValue, strDelimiter, intCompare)
  Loop
  vntData(i) = vntValue
    
  Split97 = vntData
  
End Function

【6534】Re:テキストデータからの抽出
質問  いわまる  - 03/7/7(月) 18:43 -

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

早速お返事ありがとうございます。
今、ためしに使ってみようとしたのですが・・・
素人の質問ですが、よろしくお願いします。

>  
>  '「ファイルを開く」ダイアログを表示
>  strFileFilter = "TextFile (*.txt),*.txt,CsvFile (*.csv),*.csv"

この部分には目的のテキストファイルのdirを入力すればいいのですよね?
そのまま、ファイルの場所を入力すると、

>  vntFileName = Application.GetOpenFilename(strFileFilter, 1)

「”getopenfile”メソッドは失敗しました`_Application`オブジェクト」
とエラーメッセージが出ます。

本当にしろうとの質問でごめんなさい。
現在、このマクロを保存したBookはテキストと同じフォルダに入れています。
ちなみに、excel2000を使っています。

hirofumiさん。せっかく作っていただいたのに、
使いこなせてなくてごめんなさい。

よろしくお願いします。

【6539】Re:テキストデータからの抽出
発言  Hirofumi E-MAIL  - 03/7/7(月) 21:11 -

引用なし
パスワード
   >>  
>>  '「ファイルを開く」ダイアログを表示
>>  strFileFilter = "TextFile (*.txt),*.txt,CsvFile (*.csv),*.csv"
>
>この部分には目的のテキストファイルのdirを入力すればいいのですよね?

違います、このマクロを実行すると、ファイル選択のダイアログが出てきますので
其処から、読み込むファイルを選択して下さい
因みに、strFileFilterはダイアログに表示させるファイルの拡張子を指定している物です

もし、ファイルを直接指定するので有れば、

  '「ファイルを開く」ダイアログを表示
  strFileFilter = "TextFile (*.txt),*.txt,CsvFile (*.csv),*.csv"
  vntFileName = Application.GetOpenFilename(strFileFilter, 1)
  'もし、キャンセルされた場合Subを抜ける
  If vntFileName = False Then
    Exit Sub
  End If

上記の行を削除して、その位置に以下の様なコードを記述します
このマクロを保存したBookとテキストと同じフォルダに入れているなら

  vntFileName = ThisWorkbook.Path & "\" & "TestData.csv"

これで直接ファイルを指定できます
でも、まずは、このマクロをそのまま実行して見てください

【6543】Re:テキストデータからの抽出
お礼  いわまる  - 03/7/8(火) 9:06 -

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

ありがとうございました。
うまく動きました。

ただ、最近また宿題が出されたので、
またよろしくお願いします。

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