Excel VBA質問箱 IV

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

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


2418 / 13646 ツリー ←次へ | 前へ→

【68141】フォルダ内にあるTXTファイル名の取得 ISO 11/2/5(土) 16:58 質問[未読]
【68142】Re:フォルダ内にあるTXTファイル名の取得 Yuki 11/2/5(土) 17:50 発言[未読]
【68144】Re:フォルダ内にあるTXTファイル名の取得 ISO 11/2/6(日) 18:19 質問[未読]
【68145】Re:フォルダ内にあるTXTファイル名の取得 kanabun 11/2/6(日) 19:04 発言[未読]
【68146】Re:フォルダ内にあるTXTファイル名の取得 kanabun 11/2/6(日) 20:12 発言[未読]
【68147】Re:フォルダ内にあるTXTファイル名の取得 ISO 11/2/6(日) 22:28 質問[未読]
【68148】Re:フォルダ内にあるTXTファイル名の取得 kanabun 11/2/6(日) 22:51 発言[未読]
【68150】Re:フォルダ内にあるTXTファイル名の取得 ISO 11/2/7(月) 6:37 質問[未読]
【68151】Re:フォルダ内にあるTXTファイル名の取得 kanabun 11/2/7(月) 9:56 発言[未読]
【68154】Re:フォルダ内にあるTXTファイル名の取得 ISO 11/2/7(月) 12:44 お礼[未読]

【68141】フォルダ内にあるTXTファイル名の取得
質問  ISO  - 11/2/5(土) 16:58 -

引用なし
パスワード
   マクロでフォルダ内にある複数のTXTファイル名をSheet1の列Aに取得し、
TXTファイルを開き開いたファイルの中に、ファイル名と同じ値があるか検索する。
(TXTファイルの中は値が入っているセルは固定ではありません。)
あれば列Bに「有」、無ければ「無」と入れる。
といった事をしたいと思います。よろしくお願いします。

「フォルダ内のTXTファイル」
99010100.TXT
990101A00.TXT



99015001.TXT
99015001.TXT

「99010100.TXTファイルのデータ」
列A        列B
99010100         A
2        B
3        
        Z

「990101A00.TXTファイルのデータ」
列A        列B
0        Z
9        50
100        
        990101B99

「処理結果」Sheet1
列A        列B
99010100         有
990101A00      無



99015001         有
99015001         有

【68142】Re:フォルダ内にあるTXTファイル名の取得
発言  Yuki  - 11/2/5(土) 17:50 -

引用なし
パスワード
   こんにちは。

▼ISO さん:
>マクロでフォルダ内にある複数のTXTファイル名をSheet1の列Aに取得し、
>TXTファイルを開き開いたファイルの中に、ファイル名と同じ値があるか検索する。
>(TXTファイルの中は値が入っているセルは固定ではありません。)
>あれば列Bに「有」、無ければ「無」と入れる。
>といった事をしたいと思います。よろしくお願いします。

こんな感じで
Sub TESTa()
  Const strDir  As String = "D:\Excel\Test9\AAA\"
  Dim strFNM   As String
  Dim buf()    As Byte
  Dim i      As Long
  Dim v      As Variant
  Dim io     As Integer
  
  strFNM = Dir(strDir & "*.txt")
  Do While strFNM <> ""
    io = FreeFile
    Open strDir & strFNM For Binary Lock Read As #io
      ReDim buf(LOF(io) - 2)
      Get #io, , buf
    Close #io
    v = StrConv(buf, vbUnicode)
    i = i + 1
    With Worksheets("Sheet1")
      .Cells(i, 1) = strFNM
      If InStr(v, Left(strFNM, Len(strFNM) - 4)) = 0 Then
        .Cells(i, 2) = "無"
      Else
        .Cells(i, 2) = "有"
      End If
    End With
    strFNM = Dir()
  Loop
End Sub

【68144】Re:フォルダ内にあるTXTファイル名の取得
質問  ISO  - 11/2/6(日) 18:19 -

引用なし
パスワード
   ▼Yuki さん:
ありがとうございます。
教えて頂いたコードを実行したところファイル名が「99010100.TXT」で
データ内のあるセルの値が「@99010100@」の時も「有」となります。
現状の部分一致検索を完全一致検索といった様に、この様な場合は
「無」としたいのです。
それにはInStrを変えないといけない事は分かるのですが・・・
どうしたら良いかわかりません。
よろしくお願いします。

【68145】Re:フォルダ内にあるTXTファイル名の取得
発言  kanabun  - 11/2/6(日) 19:04 -

引用なし
パスワード
   ▼ISO さん:
おじゃまさまです m(__)m

>データ内のあるセルの値が「@99010100@」の時も「有」となります。
>現状の部分一致検索を完全一致検索といった様に、この様な場合は
>「無」としたいのです。

InStrで "99010100" をさがして、
 あったら、
   その直前の1文字が vbTabまたはvbLf
   かつ、
  その直後の1文字が vbTabまたはvbCr
であることを完全一致の条件にしたらどうでしょう?

Like演算子で 同じ判定をしてもいいと思いますが。

【68146】Re:フォルダ内にあるTXTファイル名の取得
発言  kanabun  - 11/2/6(日) 20:12 -

引用なし
パスワード
   ↑直前の発言ですけど、
InStr のほうが楽そうですね

 Dim ss As String
 としておいて

こんな感じでどうでしょう

   ss = vbTab & Replace(StrConv(buf, vbUnicode), vbCrLf,vbTab)
   i = i + 1
   With Worksheets("Sheet1")
     .Cells(i, 1) = strFNM
     If InStr(ss, _
      vbTab & Left$(strFNM, Len(strFNM) - 4) & vbTab) Then
       .Cells(i, 2) = "あり"
     Else
       .Cells(i, 2) = "なし"
     End If
    :
    :

【68147】Re:フォルダ内にあるTXTファイル名の取得
質問  ISO  - 11/2/6(日) 22:28 -

引用なし
パスワード
   ▼kanabun さん:
ありがとうございます。
ファイル名が「99010100.TXT」で「@99010100@」の時は「無」と
なる様になりましたが、TXTデータ内のファイル名が一番下にある場合も
「無」となるようになってしまいました。

「99010100.TXTファイルのデータ」
列A
99010100  ←一番上や途中は「有」となる
2
3

列A
2
3
99010100  ←一番下だと「無」となる

【68148】Re:フォルダ内にあるTXTファイル名の取得
発言  kanabun  - 11/2/6(日) 22:51 -

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

>ファイル名が「99010100.TXT」で「@99010100@」の時は「無」と
>なる様になりましたが、TXTデータ内のファイル名が一番下にある場合も
>「無」となるようになってしまいました。

あぁ、文章の最後は改行コードで終わっていると仮定してましたので、
vbTab をつけてませんでしたが、そうでない場合があるなら、

> ss = vbTab & Replace(StrConv(buf, vbUnicode), vbCrLf,vbTab)



ss = vbTab & Replace(StrConv(buf, vbUnicode), vbCrLf,vbTab) & vbTab

と、してください。

【68150】Re:フォルダ内にあるTXTファイル名の取得
質問  ISO  - 11/2/7(月) 6:37 -

引用なし
パスワード
   ▼kanabun さん:
ありがとうございます。
TXTデータで文章の最後は改行はされていますので
「有」となるべきとこが「無」となってしまいます。

【68151】Re:フォルダ内にあるTXTファイル名の取得
発言  kanabun  - 11/2/7(月) 9:56 -

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

>TXTデータで文章の最後は改行はされていますので
>「有」となるべきとこが「無」となってしまいます。

いま以下のようなTAB区切りテキストファイルがあったとします。

001◆abc↓
002◆34500↓
001◆990101↓
       (ここで、
       ◆はTABコード;↓は改行コード を表します)

ファイル名が 990101.txtだとすると、
このテキストのばあいは、テキストの最後に改行があるので、
最初のReplace案のように
> ss = vbTab & Replace(StrConv(buf, vbUnicode), vbCrLf,vbTab)
により、改行コード(↓)をTABコード◆に変換した文字列

"◆001◆abc◆002◆34500◆001◆990101◆"
              ~~~~~~~~~~
のなかの "◆990101◆" を見つけるという処理で →ヒットします。


上のテキストの最後に改行コードがなかったばあい、
元のテキストは以下のように変換されることになりますから、
 "◆001◆abc◆002◆34500◆001◆990101"
この文字列には "◆990101◆" は見つかりません。→「なし」
ヒットさせるためには、
2番目のReplace案のように、文末にもTABを付加してやらねば
なりません。
>ss = vbTab & Replace(StrConv(buf, vbUnicode), vbCrLf,vbTab) & vbTab

こうすれば、
"◆001◆abc◆002◆34500◆001◆990101◆"
              ~~~~~~~~~~ とヒットさせることができます。

もちろん、ちゃんと文末に改行コードがあるばあいのテキストでも
"◆001◆abc◆002◆34500◆001◆990101◆◆"
              ~~~~~~~~~~ とヒットさせることができます。

ですから、2番目のReplace案で、文末に改行コードが付いているかいないか
で判定結果が異なる、という問題はもはや問題ではなくなっていると思い
ます。


Yukiさんのコードで気になるのは、
>      ReDim buf(LOF(io) - 2)
と 1バイト少なくbufに読んでいることです。
これだと、 文末のCRLF が CR だけになってしまわないですか?

ためしに、そこを
      ReDim buf(1 To LOF(io))
と修正して、実行しなおしてみてください。

【68154】Re:フォルダ内にあるTXTファイル名の取得
お礼  ISO  - 11/2/7(月) 12:44 -

引用なし
パスワード
   ▼kanabun さん:
ReDim buf(1 To LOF(io))と修正したところ問題ありませんでした。
丁寧な説明までして頂き、どういった処理をしているのかわかりやすく
大変たすかりました。

TXTを読み込む。With、End With。vbTab、vbLf、vbTab、vbCr。といった
わからないことが多く、ひとつひとつ勉強したいと思います。
Yukiさん。kanabunさん。大変ありがとうございました。

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