Excel VBA質問箱 IV

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

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


1755 / 13645 ツリー ←次へ | 前へ→

【72148】テキストファイルの検索 ぬうゆう 12/6/8(金) 12:04 質問[未読]
【72149】Re:テキストファイルの検索 kanabun 12/6/8(金) 13:36 発言[未読]
【72150】Re:テキストファイルの検索 kanabun 12/6/8(金) 13:59 発言[未読]
【72151】Re:テキストファイルの検索 kanabun 12/6/8(金) 17:12 発言[未読]

【72148】テキストファイルの検索
質問  ぬうゆう  - 12/6/8(金) 12:04 -

引用なし
パスワード
   初めてまして。

tVの機能をマクロに組み込もうと思っていますが、
なかなかうまくいきません。

私のやりたいことは以下のことです。
1.フォルダー内に該当ファイルが存在有無
2.フォルダー内のファイルを先頭から順次読み、
該当文字の存在有無

 ファイルはテキストファイルが対象です。
Excel2007です。

皆様の中でご存知の方がいらっしゃれば
ご教示いただければ幸いです。

よろしくお願いします。

【72149】Re:テキストファイルの検索
発言  kanabun  - 12/6/8(金) 13:36 -

引用なし
パスワード
   ▼ぬうゆう さん:

>tVの機能
ってのがあいにく分かりませんが、

>2.フォルダー内のテキストファイルを先頭から順次読み、
>該当文字の存在有無
なら、
(1) Dir関数のLoopで順次開いて検索するか、
(2) Findコマンドで すべての*.txt ファイルを一括検索してもいいです。

検索文字列はどのようなものですか? 漢字を含みますか?
それとも、検索文字は 英数字だけですか?

出力は、どのような形式で考えておられますか?
  ヒットしたファイル名だけでいいですか?
  検索文字列が含まれる行データと 行番号とか必要ですか?

【72150】Re:テキストファイルの検索
発言  kanabun  - 12/6/8(金) 13:59 -

引用なし
パスワード
   速いのは、すべておまかせの Findコマンドだとおもうので、
この例を紹介します。
結果はシートに吐き出しますので、対象シートをアクティブにして、
下の
>  v = FindText("D:\(Data)", "*.txt", "あいう")
の部分を、
FindText(検索パス, 検索ファイル名(ワイルドカード可), 検索文字列)
のようにそちらの環境に合わせて修正して試してみてください。

Sub Findtest()
  Dim v
  Cells.ClearContents
  v = FindText("D:\(Data)", "*.txt", "あいう")
  v = Split(v, vbCrLf)
  Cells(1).Resize(UBound(v) + 1).Value = Application.Transpose(v)
End Sub

'テキストファイル内の検索
Private Function FindText(LookIn$, Filename$, What$) As String
  Dim tmpPath As String
  Dim sCmd As String
  Dim ko As Long
  Dim ff() As String
 
  If Right$(LookIn, 1) <> "\" Then LookIn = LookIn & "\"
  LookIn = LookIn & Filename
  tmpPath = Environ$("Temp") & "\Find.tmp" '作業用ファイル名
  sCmd = "FIND /n """ & What & """ " & LookIn & " > " & tmpPath
  'Debug.Print sCmd
  With CreateObject("WScript.Shell")
    ko = .Run("CMD /C " & sCmd, 7, True) 'Findコマンド実行
  End With

  If FileLen(tmpPath) < 1 Then '該当ファイルがなかったときの処理
    FindText = Split("")
    Exit Function
  End If
  Dim io As Integer
  Dim buf() As Byte
  io = FreeFile()
  Open tmpPath For Binary As io 'ファイルリスト取得
   ReDim buf(1 To LOF(io))
   Get #io, , buf
  Close io
  Kill tmpPath
  
  FindText = StrConv(buf, vbUnicode)
End Function

ただ、この方式ですと、
> ---------- D:\(DATA)\CB-ABC.TXT
> "[1]あいうえお    1234.5    2004-9-14"
>
> ---------- D:\(DATA)\CONCATEABC.TXT
>
> ---------- D:\(DATA)\MIDあいう.TXT
> [1]あいう
>
> ---------- D:\(DATA)\TEMP1234.TXT
のように、見つからなかったファイル名も表示されています。
[1]は行番号です。
検索でヒットしたファイルだけ表示したいなら、出力ファイルを編集するか、
Dirで抽出した*.Txtファイルを順に開いて、自前で検索するとか、
方法を変えないといけないですね

【72151】Re:テキストファイルの検索
発言  kanabun  - 12/6/8(金) 17:12 -

引用なし
パスワード
   以下は、
Dir関数でファイルを取得、ひとつづつOpenして
一行づつ読み込み、検索文字列が含まれていたら、
それをセルに出力するサンプルです。
Sub Try_Find2()
  ActiveSheet.UsedRange.ClearContents
  SearchText "D:\(Data)", "*.txt", "あいう", ActiveSheet
  
End Sub

'A列にファイル名、B列に 一致行を出力
Private Sub SearchText(LookIn$, Filename$, What$, _
            ws As Worksheet)
  Dim f As String
  Dim i As Long, Lno As Long
  Dim io As Integer, flg As Boolean
  Dim ss As String
  
  If Right$(LookIn, 1) <> "\" Then LookIn = LookIn & "\"
  f = Dir$(LookIn & Filename)
  io = FreeFile()
  Do While Len(f) > 0
    Open LookIn & f For Input As io
    flg = True
    Lno = 0
    Do Until EOF(io)
      Lno = Lno + 1
      Line Input #io, ss
      If InStr(1, ss, What, vbTextCompare) > 0 Then
        If flg Then
          i = i + 1
          ws.Cells(i, 1).Value = f
          flg = False
        End If
        i = i + 1
        ws.Cells(i, 2).Value = "[" & Lno & "] " & ss
      End If
    Loop
    Close io
    
    f = Dir$()
  Loop
End Sub

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