『複数のブックを別ブックで管理したい』(ちょめ)
ExcelのVBAで教えていただきたいです。
毎日使用している1人1人のファイルのデータを、管理用として作成したファイルにまとめたいです。
1.個人が使用しているデータは全て同一の共有フォルダにあり、Sheet1に共通してA列案件名、B列開始時間、C列終了時間を記録しています。毎日使用するため、行数は増えます。また、ファイル名も「対応状況_〇〇さん」というように〇〇の部分に名前を変えてます。スタッフも増減するので、ファイル名は指定して固定しないやり方にしたいです。(同じフォルダに入ってます)
2.管理用にも同様にSheet1というシートでVBAを使用して転記をしたいのですが、その際に管理側でボタンを設置してクリックで完結できるようにしたいと考えています。
3.転記には見出し行以降2行目〜を個人のシートを結合する形で実行したいです。
4.個々のブックは開かずにお願いします。
下記のYouTube動画の数式を使って別ブックを参照よりやってみて、転記元のブックは開かれずに1行目だけは反映されましたが、1人分のみしか取れないのと、セルの範囲を入っている行全てとする方法がわからず、、
https://youtu.be/FSS94HnW3Dk?si=zUdeHxnNwYePrpuY
教えていただけますと幸いです。
< 使用 Excel:Microsoft365、使用 OS:Windows11 >
普通にひとつずつ開いて、転記、閉じる を繰り返すのが簡単ですし、自然です。曲芸は不要です。
(xyz) 2025/09/29(月) 23:19:29
■2
また、少なくとも現状のコードを示されては如何でしょうか?(無論、フォルダパスなどは架空のものにして構いません)
パッと思いつく限りでは、ファイルパスおよびシート名、セル番地を指定して値を取り出すことは可能でしょうが、1セルずつ対応することになる(当方の勘違いだったらごめんなさい)ので、ファイルを開かずに済むメリットが効率の悪さを上回ることはないと思いますが、できない話でもないので、もしかしたらアドバイスできることがあるかもしれません。
■3
なお、「毎日使用するため、行数は増えます。」の部分も気になります。
ブックを開かずに、転記済の行と未転記の行を見分ける必要が出てくると思うのですが、どのようにする発想なんでしょうか?
(もこな2) 2025/09/30(火) 07:22:21
1) フォルダ内の全てのファイル名を取得。 2) 各ファイルのSheet1!A列の最終行を取得。 3) 管理用ブックに数式で必要データを転記。 4) 必要に応じて数式を値に変換、ファイル名も付加。
とか... (jindon) 2025/09/30(火) 11:00:59
知恵袋消したね。 どうせこっちでも何のフィードバックもせずにコードだけ取ってくんじゃない?笑 詳細確認しようとしてる人時間の無駄ですよ (まず,これを載せるのが筋では?) 2025/09/30(火) 11:20:51
私もその質問に回答した1人だから、すげームカつくんだよな。 なにが希望と沿わなかったのかくらい教えてくれや (まず,これを載せるのが筋では?) 2025/09/30(火) 11:22:10
ご存じのかたがいらっしゃれば教示ください。
jindonさんの方針のなかで > 2) 各ファイルのSheet1!A列の最終行を取得。 と言う作業がありますが、 これはファイルを開かずにどうやったら実現できますか? 私はなにか難しいように思っています。
(xyz) 2025/10/01(水) 17:57:24
数式で求めるのでは? (マナ) 2025/10/01(水) 18:17:30
最終行=A列のデータ個数とするとCOUNTAで
Sub test() Dim p As String Dim fn As String
p = ThisWorkbook.Path & "\" fn = "Book1.xlsx"
MsgBox ExecuteExcel4Macro("COUNTA('" & "[" & fn & "]Sheet1'!C1:C1)")
End Sub (マナ) 2025/10/01(水) 18:52:39
なるほど手段を限定していました。 ( Get.Document(10,...)といったものの利用です。これはファイルが開かれていることが必須です。) もっと今どきの関数を使えば可能でした。ありがとうございました。
(xyz) 2025/10/01(水) 19:09:16
質問者から具体的に聞かれれば回答するつもりたったが
Dim myDir$, fn$, s$, x& myDir = ThisWorkbook.Path & "\" fn = Dir(myDir & "*.xls*") Do While fn <> "" If myDir & fn <> ThisWorkbook.FullName Then s = "'" & myDir & "[" & fn & "]sheet1'!r1c3:r500000c3" x = ExecuteExcel4Macro("max(index((len(" & s & ")>0)*row(" & s & "),0))") End If fn = Dir Loop (jindon) 2025/10/01(水) 19:18:58
Microsoft365なので、TrimRangeで1シート分が一発で転記出来そう。
(半平太) 2025/10/01(水) 19:28:53
ADO接続でも簡単ですね。 (jindon) 2025/10/01(水) 19:31:21
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.