ここから本文です

VBA初心者です。 エクセルVBAについて、詳しい方のご教授をお願い致します。 ■...

muk********さん

2020/2/2315:04:11

VBA初心者です。
エクセルVBAについて、詳しい方のご教授をお願い致します。

■やりたいこと
C:\作業用フォルダを検索。

検索キーとなる「xxxx」のフォルダがあった場合は、そのフォルダ内にある複数のサブフォルダから、”Aチーム”、”Bチーム”のサブフォルダのみを検索。
”Aチーム”、”Bチーム”のサブフォルダ内にテキストファイルが在れば、フルパスを指定したセルに表示させる。

■フォルダ体系
C:\作業用フォルダ\xxxx\Aチーム(Bチーム、Cチーム、Dチーム、Eチーム・・・)

■条件
条件1.検索キーとなる「xxxx」のフォルダ在り、AチームとBチームのサブフォルダ内にテキストファイル在りの場合は、フルパスを所定のセル(C、10)に表示させる。
「xxxx」のフォルダ内に複数のサブフォルダが存在しているが、検索するサブフォルダはAチームとBチームのフォルダのみ。
条件2.「xxxx」のファルダが無い場合は、”フォルダ無し”のメッセージを表示。
条件3.「xxxx」のフォルダは在るが、”Aチーム”、”Bチーム”のサブフォルダ内にテキストファイルが無かった場合は、”作業無し”のメッセージを表示。

■処理手順
1.マクロを実行すると「フォルダ名(xxxx)」を入力するユーザーフォームが表示される。
2.「フォルダ名」を入力して、実行する。 ※フォルダ名=検索キー
3.検索キーと一致するフォルダが無ければ、「フォルダ無し」のメッセージを表示。※条件2
4.検索キーと一致するフォルダがあった場合は、そのフォルダ内にある”Aチーム”、”Bチーム”のサブフォルダのみを検索。
5.”Aチーム”、”Bチーム”のサブフォルダ内にテキストファイルが無ければ、”作業無し”のメッセージを表示。 ※条件3
6.”Aチーム”、”Bチーム”のサブフォルダ内にテキストファイルが在れば、フルパスを所定のセルに表示させる。 ※条件1

■条件1を満たす場合
セル(C、10)C:\作業用フォルダ\xxxx\Aチーム\作業1.txt
セル(C、11)C:\作業用フォルダ\xxxx\Aチーム\作業2.txt
セル(C、12)C:\作業用フォルダ\xxxx\Bチーム\作業3.txt
セル(C、13)C:\作業用フォルダ\xxxx\Bチーム\作業4.txt
セル(C、14)C:\作業用フォルダ\xxxx\Bチーム\作業5.txt
作業1~作業5までのテキストファイルのフルパスを所定のセルに表示。

■条件2を満たす場合
C:\作業用フォルダ内に「xxxx(検索キー)」が無い場合、「フォルダ無し」のメッセージを表示。

■条件3を満たす場合
C:\作業用フォルダ内に「xxxx(検索キー)」は在るが、サブフォルダのAチームまたはBチーム内にテキストファイルが無い。または、AチームまたはBチーム以外のサブフォルダ内にテキストファイルがあった場合でも、「作業無し」のメッセージを表示。

拙い説明かと思いますが、おわかり頂けましたでしょうか。
わかる方がいらっしゃいましたら、ご教授の程、何卒よろしくお願いいたします。

閲覧数:
46
回答数:
1
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

hot********さん

2020/2/2323:33:53

セル(C、10)、セル(C、11)・・・がC10,C11...だと思いますが、その場合です。

Sub sample()
Dim fso As Object
Dim rootFolder As String
Dim targetFolder As String
Dim subFolder As Variant
Dim r As Long
Dim file As String
rootFolder = "C:\作業用フォルダ\" '大本のフォルダ
targetFolder = InputBox("フォルダ=") 'フォルダ名入力
If targetFolder = "" Then Exit Sub '空白なら終わり
'フォルダ検索
Set fso = CreateObject("Scripting.FileSystemObject") 'fso
If Not fso.FolderExists(rootFolder & targetFolder) Then '目的のフォルダが無ければ
MsgBox subFolder & " フォルダ無し"
Exit Sub '終了
End If
'Aチーム、Bチーム内テキスト検索
Range("C10:C" & Rows.Count).ClearContents '結果クリア(必要なら)
r = 10 '結果表示行(初期値=10)
For Each subFolder In Array("Aチーム", "Bチーム") 'サブフォルダを順に
file = Dir(rootFolder & targetFolder & "\" & subFolder & "\*.txt") 'サブフォルダ内のテキストファイル
Do While file <> "" 'ファイルがある間
Range("C" & r).Value = rootFolder & targetFolder & "\" & subFolder & "\" & file 'テキストファイル名表示
r = r + 1 '結果表示行+1
file = Dir '次のファイル名
Loop
Next
If r = 10 Then MsgBox "作業無し"
End Sub

  • 質問者

    muk********さん

    2020/2/2810:58:26

    ご教授ありがとうございます!
    コメント入りの大変わかりやすい構文、こちらの想定通りの処理となっており、大変助かりました。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2020/2/28 10:59:39

ありがとうございました!
コメント入りの構文で大変助かりました!

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる