Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10全般 : Excel 2016)
変数に格納されたオブジェクト名を含むファイル検索
投稿日時: 21/09/29 17:11:07
投稿者: chiii1519

フォルダ【集計】内にあるファイル名の一部に、ファイル1(該当マクロ付きファイル)のA列“子番号”を含むファイルを検索し、必要なデータをファイル1の該当行(セル)へ記録したいです。
 
【1】子番号を変数bufへ格納
 
【2】親番号(子番号)氏名.xlsmのファイル名から一致するファイルを検索
 ※案件により“子番号”に枝番@〜Bを含むデータも存在しています。
 
【3】各 親番号(子番号)氏名.xlsm 内のセルU41の値を
bufと完全一致…D列
buf&“@”…D列
buf&“A”…E列
buf&“B”…F列
へ転記
 
【4】K41の値を
bufと完全一致…G列
buf&“@”…G列
buf&“A”…H列
buf&“B”…I列
へ転記
 
【5】ファイルの保存日をC列へ記録
 

CSV-Data		BK−Data						
子番号	予備列	保存年月日	¥@	¥A	¥B	%@	%A	%B
201156								
201157								
201158								
201159								
11516								
11517								
11519								
11521								
3750								
5780								
5783								
5938								
200087								
2684								
10976								
11103								
10562								
10563								

 
ご教示お願い致します。

回答
投稿日時: 21/09/29 19:40:59
投稿者: simple

詰まっているのは、どんなところでしょうか。
ご自分で出来ているところまでを部分的で結構ですので、提示してもらえますか?

回答
投稿日時: 21/09/29 20:29:17
投稿者: simple

野暮なことを申し上げるようですが、

禁止事項 さんの引用:
コード制作依頼
「●●●を実行するようなマクロを作りたいのですが」「●●●をする方法を教えてください」といった、コード制作依頼ともとれるような質問はおやめください。
というのがあり、心底賛成するわけでもないのですが、一応、管理者さんが決めたものなので、
守ってもらいたいと思っています。
簡単で結構なのでコメントして下さい。

回答
投稿日時: 21/09/29 22:28:37
投稿者: simple

なかなか返事がありませんが、確認です。
>※案件により“子番号”に枝番@〜Bを含むデータも存在しています。
ということは、子番号201156について、
親番号(201156@)氏名.xlsm
親番号(201156A)氏名.xlsm
親番号(201156B)氏名.xlsm
といった3つのブックがありうるわけですね。
保存年月日を記入する列はひとつしかないですが、その場合はどうするんですか?
それとも一つなんですか?
 
対象とするブックの中のシートの数は?

回答
投稿日時: 21/09/30 12:04:41
投稿者: Suzu

全体の流れとしては
 
1.    ファイル1 のA列の最終行を取得
2.    A2から 1. にて取得した行までをループ処理
3.        A列の値を buf へ代入
4.        Dir関数を用いて、ファイル名に、bufを含むファイルの存在確認
5.        Dir関数の戻り値が"" 以外 の時、ループ処理
6.            FileDateTime関数に、開くファイルのパスを渡し、作成日/更新日 を取得し、C列に代入
7.            転記元のbufを名称に含むファイルを 読み取り専用にて開く
8.            ファイルの K41、U41 の値を取得
9.            開いた buf を含む ファイル名により、ファイル1への転記先を決定し、値を代入
10.            ファイルを閉じる
11.        Dir関数の戻り値が"" 以外 の時、ループ処理 終わり
12.    A2から 1. にて取得した行までをループ処理 終わり
 
の様になるでしょうか。
(コピー元のシートが特定の場合)
 
 
FileDateTime関数
https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/filedatetime-function
 
 
Bookファイル をExcelにて開くのは時間が掛かります。
今回の様に、数個のセルの値を取得するのであれば、Excelにて、開かなくて済むので速くはなります。
 
閉じたブックからデータを取得する
https://www.moug.net/tech/exvba/0060037.html
 
を参考に。
 
ただし
・シート名は 既知で固定
・参照先のセルは、数式ではなく、値が入っている事
   (ファイルを開く方法なら再計算されますが、この方法では再計算前の値が取得される場合もある)
に留意ください。

投稿日時: 21/09/30 15:52:03
投稿者: chiii1519

shimple様
 
会社のPCで閲覧している為お返事が遅くなり申し訳ありません。
 
ご親切にありがとうございます。
 
親番号(201156)氏名.xlsm
もしくは
親番号(201156@)氏名.xlsm
親番号(201156A)氏名.xlsm
親番号(201156B)氏名.xlsmのファイルが存在します。
(つまり、親番号(201156)氏名.xlsm で保存されている場合は親番号(201156@)氏名.xlsm以降のファイルは存在しません。)
 
保存年月日は、親番号(201156)氏名.xlsmもしくは親番号(201156@)氏名.xlsmのデータが必要です。
 
ブックのシートは1つです。
 
VBAスタンダードを取得したばかりで 変数、、、ループ、、、何をどう組み合わせたら良いのか。
応用が利かず苦労しています。
形になっていませんが、規約上お返事頂けるようでしたらお力を貸して頂けると幸いです。
 

Sub BK照合()

'処理の高速化

    With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    End With
    
    
'子番号を転記
    
    Dim ws As Worksheet
    Set ws = Workbooks("マスタ.xlsm").Sheets("記録用")
    
    ThisWorkbook.Activate
    Range("A3").Select
    ws.Activate
    Range("B3", Range("B3").End(xlDown)).Copy
    ThisWorkbook.Activate
    Selection.PasteSpecial xlPasteValues

'**を転記
    
    ThisWorkbook.Activate
    Range("B3").Select
    ws.Activate
    Range("E3", Range("E3").End(xlDown)).Copy
    ThisWorkbook.Activate
    Selection.PasteSpecial xlPasteValues

'評価番号を変数bufへ格納

    Dim buf As Range
    Set buf = ThisWorkbook.Sheets("Sheet1").Range("A3", Range("A3").End(xlDown))
↑これはエラーになりました。

'(変数buf(評価番号)を収益ツールBKより検索・ファイル名取得
'(※1つの子番号でファイルが複数ある場合(@orAorB)各々ひろってくる)
    
    
'当マクロつきブックと同一階層内の"BK-check" フォルダ内のファイルからデータ取得


    fol = ThisWorkbook.Path

    file = Dir(fol & "\BK-check\" & *(*" & buf & "*)*")

投稿日時: 21/09/30 15:57:52
投稿者: chiii1519

コード内 BK-Check フォルダ⇒ 質問文 集計
コード内 管理番号⇒ 質問文 子番号 の誤りです。

回答
投稿日時: 21/09/30 18:52:53
投稿者: simple

以下を試してみて下さい。
 

Option Explicit
Dim thisWs As Worksheet

Sub test()
    Const path As String = "D:\Mydocuments\202109\test\"
                    '●適宜修正のこと(\で終わることに注意)
    Dim child As String
    Dim p As Long
    Dim s As String
    Dim k As Long
    Dim f As String
    Application.ScreenUpdating = False
    Set thisWs = ThisWorkbook.Worksheets("Sheet1")  ' ●適宜修正
    
    For k = 2 To thisWs.Cells(Rows.Count, "A").End(xlUp).Row
        child = thisWs.Cells(k, "A")
        f = Dir(path & "*(" & child & "*.xlsm")
        Do While f <> ""
            p = InStr(f, child)
            s = Mid(f, p + Len(child), 1) ' 子番号の次の1文字
            
            Select Case True
            Case s = "@" Or s = ")":
                            Call setData(path & f, k, 1)
            Case s = "A":  Call setData(path & f, k, 2)
            Case s = "B":  Call setData(path & f, k, 3)
            End Select
            f = Dir()
        Loop
    Next
    Application.ScreenUpdating = True
End Sub

'fullpathファイルを読み込んで、特定セルを書き出す
Function setData(fullpath As String, k As Long, j As Long)
    Dim wb As Workbook
    Dim ws As Worksheet
    If j = 1 Then
        thisWs.Cells(k, 3) = FileDateTime(fullpath)
    End If
    
    Set wb = Workbooks.Open(fullpath)
    Set ws = wb.Worksheets(1)
    thisWs.Cells(k, 3 + j) = ws.Range("L41")
    thisWs.Cells(k, 6 + j) = ws.Range("K41")
    wb.Close False
End Function

懸念点はファイル名の全角半角問題ですね。(勿論対応策はありますが)

回答
投稿日時: 21/10/01 16:58:47
投稿者: Suzu

simple さんの引用:
懸念点はファイル名の全角半角問題ですね。(勿論対応策はありますが)

 
こちらは、
simple さんの引用:

            p = InStr(f, child)
            s = Mid(f, p + Len(child), 1) ' 子番号の次の1文字
             
            Select Case True
            Case s = "@" Or s = ")":
                            Call setData(path & f, k, 1)
            Case s = "A": Call setData(path & f, k, 2)
            Case s = "B": Call setData(path & f, k, 3)
            End Select

の部分ですよね。
 
s を 切り出さずに判定してしまってはどうでしょうか。
 
          Select Case True
            Case f Like "*" & child & "@*.xlsx" : Call setData(path & f, k, 1)
            Case f Like "*" & child & "A*.xlsx" : Call setData(path & f, k, 2)
            Case f Like "*" & child & "B*.xlsx" : Call setData(path & f, k, 3)
            Case f Like "*" & child & "*.xlsx" : Call setData(path & f, k, 1)
          End Select
 
同じ Call先を 2回と言うのは恰好悪いかな。。

投稿日時: 21/10/01 17:11:23
投稿者: chiii1519

Simple様
 
御協力頂きましてありがとうございます。
 
先のコードからファイルパス、シート名を変更し実行すると、
 
実行時エラー‘424’:オブジェクトが必要です
になりました。
デバック画面では

'fullpathファイルを読み込んで、特定セルを書き出す
thisWs.Cells(k, 3) = FileDateTime(fullpath)

箇所がマーキングされています。
 
Suzu様
返事が遅くなり申し訳ございません。
 
手順と参考URLのご教示をありがとうございます。
1つずつ調べながら作成に取り組みたいと思います。
 
御協力に大変感謝しております。

回答
投稿日時: 21/10/01 18:19:47
投稿者: simple

Suzuさん、おっしゃるとおりですね。ご指摘ありがとうございます。
ただ、
親番号(201156C)氏名.xlsm
親番号(201156A)氏名.xlsm
なんてのがもしあれば、それに食いついてしまうので、限定したかったわけです。
 
質問者さん
エラーになったときの、
thisWs 変数はどうなっていますか。
k の値は何でしょうか。
ローカルウィンドウを確認してもらえますか?

回答
投稿日時: 21/10/01 18:34:45
投稿者: simple

全角半角問題というのはこんなことでした。
 
子番号が親番号の一部に混入しているリスクを排除するために、
前に "("をつけて、Dirを当てています。
また、丸付き数字なしが無いことをチェックするために
直後に")"があることを条件にしたのですが、
ファイル名のほうが全角だったりすると、そもそも抽出ができませんし。
閉じるほうの括弧が全角だったりすると判定が狂ってきます。
まあ、杞憂に近いのでしょうけど、結構ありうるかなと。

回答
投稿日時: 21/10/02 11:57:45
投稿者: simple

(1)
# 何も断らない限り、私は自分で動作することを確認したうえで
# 投稿することにしています。
 
私の投稿をコピーするときに、
Option Explicit
Dim thisWs As Worksheet
の二行を飛ばしてしまっていて、test以下しか使っていないのではないですか?
また、Option Explicit
を使わない習慣になっていませんか?(下記するように直ぐに変更したほうがいいですよ)
 
Dim thisWs As Worksheet
はプロシージャが開始するまえに宣言する
いわゆる"モジュールベースの"変数です。
test,setDataいずれのプロシージャでも共通して使えるように
意図したものです。
 
また、仮にこれを飛ばしてしまったとしても、
Option Explicit
がモジュールの先頭に書いてあれば、
「thisWsが定義されていません。」と
コンパイルエラーになるはずなのです。
 
(2) Option Explicitは重要です。
 
Option Explicit
をモジュールの一行目に挿入するようにして下さい。
そうすれば、今回のような未定義の変数には警告が出て、
しかも場所を特定してくれますから、原因が直ぐに判明します。
 
http://officetanaka.net/excel/vba/beginner/06.htm
を参照。
 
VBEの 「ツール」 − 「オプション」 − 「編集」 で
「変数の宣言を強制する」にチェックを入れてください。
モジュールを作成した時点で、Option Explicitが自動的に挿入されるので、
手間が省けます。
一度だけチェックを入れておきさえすれば、以後、気にする必要はありません。
 
# 返事は来週でも結構ですが、こちらが覚えていないかもしれないので、書いておきます。

回答
投稿日時: 21/10/04 09:19:07
投稿者: Suzu

simple さんの引用:
全角半角問題というのはこんなことでした。
 
子番号が親番号の一部に混入しているリスクを排除するために、
前に "("をつけて、Dirを当てています。
また、丸付き数字なしが無いことをチェックするために
直後に")"があることを条件にしたのですが、
ファイル名のほうが全角だったりすると、そもそも抽出ができませんし。
閉じるほうの括弧が全角だったりすると判定が狂ってきます。
まあ、杞憂に近いのでしょうけど、結構ありうるかなと。

 
その様な意図だったのですね。当方の懸念とは別の部分でしたね。承知しました。
 
ファイル名を含めた名前付け規則は、運用にも関わる話ですから
質問者さん側で判断して貰えれば良いですね。
 
失礼しました。

投稿日時: 21/10/04 11:42:01
投稿者: chiii1519

コードのご説明について、1行ずつじっくり拝読させて頂きました。
 
shimple様、suzu様 ご丁寧にご指導頂きましてありがとうございます。
 
Option Explicitを使用する習慣がありませんでした。
ご指摘の通り、飛ばして使用していました。
変数の宣言の重要性を知り大変勉強になりました。
 
実行しましたところ
保存年月日は欲しいファイルから全て取得出来ていました。
 
しかし、¥@〜%Bまでが記録されていなかったので
wbのファイル自体に問題があるのではと考えて原因を調べています。
 
考えられる原因として
 
・wsの前シートに非表示のシートが存在すること
・wsのU~X列が結合されていること
・マクロを実行した際、wbを1つずつ開く部分で
該当ファイル全てリンクの自動更新メッセージが出たので
オプション画面より“リンクの自動更新前にメッセージを表示する”のチェックをはずしたこと
 
が思い当たります。
 
因みに、暫定ファイルとして1シートかつ(子番号@〜B)のファイルを作成し、実行したところ上手くいきました。

回答
投稿日時: 21/10/04 14:12:17
投稿者: Suzu

引用:
しかし、¥@〜%Bまでが記録されていなかったので
wbのファイル自体に問題があるのではと考えて原因を調べています。

 
simple さん の提示されたコードには エラートラップは含まれていません。
よって、考えられるのは、
・転記するコードである、setData 内で 書き込みがされない
・そもそもの転記を行うコードである setData を呼び出していない
のどちらかです。
 
setData は ファイルを開き、書き込み 動作ですから
後者である、setDataを呼び出していないのではありませんか?
 
 
シングルステップ にて、
記録されない wbファイル が処理されている最中の
 
        Do While f <> ""
            p = InStr(f, child)
            s = Mid(f, p + Len(child), 1) ' 子番号の次の1文字
            
            Select Case True
            Case s = "@" Or s = ")":
                            Call setData(path & f, k, 1)
            Case s = "A":  Call setData(path & f, k, 2)
            Case s = "B":  Call setData(path & f, k, 3)
            End Select
            f = Dir()
        Loop

 
ここの 流れを確認し、setData が Call されているのか確認してください。
 
Callされていないのであれば その時の条件分岐の条件としなっている s の値を確認しましょう。

回答
投稿日時: 21/10/04 22:39:04
投稿者: simple

>対象とするブックの中のシートの数は?
という私の確認質問に対して
>ブックのシートは1つです。
という回答をあなたから得ています。
 
非表示のシートがあったとは"寝耳に水"です。(いや、まだ起きているけど。)
 
で、気を取り直して、

    Set ws = wb.Worksheets(1)
    thisWs.Cells(k, 3 + j) = ws.Range("L41")
    thisWs.Cells(k, 6 + j) = ws.Range("K41")
としているところを
    For Each ws In wb.Worksheets
        If ws.Visible Then
            thisWs.Cells(k, 3 + j) = ws.Range("L41")
            thisWs.Cells(k, 6 + j) = ws.Range("K41")
        End If
    Next
としてみてください。
表示されたシートについてだけ処理するようにしています。
もしも、表示されたシートが複数あれば、
最後のシートの内容が転記される(上書きされる)ことになります。

回答
投稿日時: 21/10/04 23:08:02
投稿者: simple

    For Each ws In wb.Worksheets
        If ws.Visible Then
            thisWs.Cells(k, 3 + j) = ws.Range("L41")
            thisWs.Cells(k, 6 + j) = ws.Range("K41")
            Exit For
        End If
    Next
とすると、少しでも無駄が減らせるでしょう。

回答
投稿日時: 21/10/06 23:38:43
投稿者: simple

こちらの説明が伝わらなかったでしょうか?
 
開いたブックにはシートがひとつしかないと聞いていたので
wb.Worksheets(1)
でそのシートが捕まえられるはずと思っていました。
 
【なぜ想定した結果にならなかったのか】
 
しかし、
>・wsの前シートに非表示のシートが存在すること
ということであれば、
wb.Worksheets(1)のindex(つまり1)は
表示・非表示にかかわらずカウントされますから、
wb.Worksheets(1)は、一番左のシートということで、
非表示になっているシートを指しています。
 
そのシートの該当セルにはたぶん何も入力されていないので、
取得結果はあなたの想定外のものになったということでしょう。
 
【では、どうすべきなのか】
 
>・wsの前シートに非表示のシートが存在すること
がどのブックでも正確に言えるのであれば、
wb.Worksheets(2) と変更すればいいだけです。
表示されたシートを指しますので、そこからデータを取得すればOKです。
 
なお、私が提示した案は、そうしたことが必ずしも保証できない場合でも、
表示・非表示の状況を判断して、
「最初の表示されたシート」からデータを取得するようにしたものです。
 
おわかりいただけました?
 
情報の提示もれを指摘したことに、気分を害しているのでしょうか。
あなたの気持ちを忖度して、遠慮して黙っていたら物事は前に進みません。
 
丸2日が経過しましたが、回答コメントがあったのですから、
そして大作業がそちらで必要ということでもないと思いますから、
とりあえずの返事くらいして頂きたい。
多忙を極めていてそれどころでないなら、その旨簡単にコメントしていただきたい。
放置は戴けません。マナーだと思います。
 
もう興味を失った話なんでしょうか?
もしそうなら、残念ではありますが致し方ないです。閉じてください。

投稿日時: 21/10/11 10:14:42
投稿者: chiii1519

お返事が大変遅くなり申し訳ございません。
コロナワクチンの副作用で脳貧血を起こし連絡が出来ませんでした。
 
内容について確認し、実行したところ問題なく動きました。
 
お忙しいところ御協力頂きましてありがとうございました。
大変勉強になりました。
 
度々失礼があり貴重なお時間を頂いたにも関わらずお返事も出来ず申し訳ございませんでした。