Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
2417 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【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さん。大変ありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
2417 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free