質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

4回答

436閲覧

複数ブックへの操作 ブックが開かれていた場合

ichigo15

総合スコア14

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2020/03/09 00:40

前提

サーバー上にあるフォルダ内の複数のブックより条件に応じて抽出をします。

問題点

今は時間を指定して抽出作業中はブックを開かないようにしてもらってます。
ですが、ブックを開いていけないことを忘れて開いてしまう人がいます。
そうすると、既に抽出したものは次回抽出されないようにセルに"◎"を入れるように
してますがこの"◎"が入力されないので2重に抽出されてしまいます。

誰かがブックが開かれている場合は、そのブックの抽出は行わず、MsgBoxでどのブックが開かれているかまとめて表示したいです。

ご指導いただけないでしょうか
宜しくお願いいたします。

該当のソースコード

Sub 抽出() Dim Fname As String Dim dStart As Double, dEnd As Double Dim srcSH As Worksheet Dim dstRNG As Range Dim cel As Range Set dstRNG = ThisWorkbook.ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Offset(1, -3) dEnd = DateValue(uf2.tx1) + TimeValue(uf2.tx2) Fname = Dir(ThisWorkbook.Path & "*.xls*") Do While Fname <> "" If Fname <> ThisWorkbook.Name Then Set srcSH = Workbooks.Open(ThisWorkbook.Path & "\" & Fname).Worksheets(1) srcSH.AutoFilterMode = False Dim i As Long For i = 11 To Cells(Rows.Count, 4).End(xlUp).Row If Cells(i, 3) = "" Then Cells(i, 4).Copy Cells(i, 4) End If Next i Range("A10").AutoFilter Field:=2, Criteria1:="<=" & CStr(dEnd) Range("A10").AutoFilter Field:=8, Criteria1:="=" If srcSH.AutoFilter.Range.Cells(1).Row <> srcSH.Cells(srcSH.Rows.Count, "D").End(xlUp).Row Then With srcSH.AutoFilter.Range Intersect(.Cells, .Offset(1), srcSH.Range("H:H"), .SpecialCells(xlCellTypeVisible)).Value = "◎" Intersect(.Cells, .Offset(1)).Copy dstRNG With dstRNG.Parent Set dstRNG = .Cells(.Rows.Count, "D").End(xlUp).Offset(1, -3) End With End With End If srcSH.AutoFilterMode = False srcSH.Parent.Save srcSH.Parent.Close End If Fname = Dir() Loop Application.ScreenUpdating = True Unload uf2 End Sub

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答4

0

今は時間を指定して抽出作業中はブックを開かないようにしてもらってます。

業務時間外に実行するようにすれば良いのではないですか?
エラーが発生したら、そのままエクセルを開いたまま残すようなVBSを作成し、朝6時(業務時間外なら何時でも良い)など誰も出社していない時間に設定を行いえば済む話ではないかと思います。

投稿2020/03/09 03:32

stdio

総合スコア3307

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ichigo15

2020/03/09 03:45

セキュリティの関係でPCは電源を落として鍵のかかる場所に保管いたします。 また業務時間外も仕事をしていますので誰も仕事をしていない時間を毎日把握するのは不可能です。 それと抽出したものを毎日報告しないといけません。 せっかくですが外部も関係するのでこちらでは抽出内容を変更することは不可能です。
stdio

2020/03/09 07:01

> セキュリティの関係でPCは電源を落として鍵のかかる場所に保管いたします。 セキュリティの関係なら、配線可能なロッカーが売ってますよ。中に電源をつけっぱなしのPCも設置可能です。自動化なんですから、配線可能なロッカーぐらい、稟議すぐに通りますよ。 > また業務時間外も仕事をしていますので誰も仕事をしていない時間を毎日把握するのは不可能です。 夜勤がある現場なのかしら... 昔は1日中働いても文句言われませんでしたが、現代の法律なら労働基準法違反になります。 >毎日報告しないといけません。 抽出内容の取得だけなら別にやっても良い気がします。そしてVBAならOutlook操作してメール飛ばすぐらいのことは可能です。報告ならそれで十分でしょう。 それにVBSからVBAを呼べるので、タスクスケジューラに登録するのも容易です。 実際、私もやってます。技術がないと泣いてないで、まずネットで検索することをお勧めします。
guest

0

今は時間を指定して抽出作業中はブックを開かないようにしてもらってます。

ですが、ブックを開いていけないことを忘れて開いてしまう人がいます。

いつ開かれていても問題ない仕様にできれば、皆が幸せになれそうな気がします。

誰かがブックが開かれている場合は、そのブックの抽出は行わず、MsgBoxでどのブックが開かれているかまとめて表示したいです。

これはMsgBoxを見た後、運用でカバーになります。
あくまでも、本来の目的は、
0. 抽出したいタイミングで抽出が可能で、

  1. 抽出済みかどうかを管理可能とする。

であるなら、作業用のExcelファイル群に対して抽出済みのフラグを書き込むよりは、抽出済みデータを管理するExcelファイルを別に用意するのが良いと思います。
抽出作業をするときには、管理用Excelファイルを参照し、そこに記載がないデータだけ抽出して、抽出後は管理用Excelファイルに書き込むようにすれば良いのではないでしょうか?
管理用のExcelファイルは、質問者さんしか触れない場所に置いておくと良いでしょう。

これで他の人にブックを開かないようにお願いする必要もなくなると思います。

投稿2020/03/09 02:42

Secret

総合スコア220

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ichigo15

2020/03/09 03:28

コメントありがとうございます。 本来の目的は 誰かがブックが開かれている場合は、そのブックの抽出は行わず、MsgBoxでどのブックが開かれているかまとめて表示したいです。 抽出のタイミングは決まっております。 これは各ブックへの入力期限も兼ねてます。 また入力者が抽出済であることを把握したいという目的に合わせて入力ブックに抽出済であることが分かるようにしております。 せっかくですが今回は運用の諸事情並びにExcelが不得意な者が混乱するといけないので今の運用を変更するつもりはありません。
guest

0

ベストアンサー

ブックが開かれているかどうか調べる
こちらのサイトを参考に作ってみました。
またディレクトリ内のファイル走査とWhileループ部分は
貼られてるソースの処理を流用させていただきました。

追記
大変申し訳ないことをしてしまいました。
私の方のコーディングミスです。ソース修正しました。
メッセージ出力についてはソース下部の「'メッセージ出力」部分の記述で出力できます。

VBA

1Fname = Dir(ThisWorkbook.Path & "*.xls*") 2'MsgBox用メッセージ 3FnameMsg = "" 4Do While Fname <> "" 5 6 On Error Resume Next 7 Open ThisWorkbook.Path & "\" & Fname For Append As #1 8 Close #1 9 'ブックが開かれている場合 10 If Err.Number > 0 Then 11 'ファイル名をMsgBox用メッセージに追記 12 FnameMsg = FnameMsg & Fname & vbCrLf 13 End If 14 15 Fname = Dir() 16Loop 17 18'メッセージ出力 19MsgBox FnameMsg

投稿2020/03/09 01:13

編集2020/03/09 05:45
yureighost

総合スコア2183

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ichigo15

2020/03/09 05:34

コメントありがとうございます。 参考に作成してみました。 知識が低いため見て頂けないでしょうか。 抽出については希望通りできましたがメッセージが出なかったです。 ご指導お願いいたします。 ```ここに言語を入力 Sub 抽出() Dim Fname As String Dim dStart As Double, dEnd As Double Dim srcSH As Worksheet Dim dstRNG As Range Dim cel As Range Set dstRNG = ThisWorkbook.ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Offset(1, -3) dEnd = DateValue(uf2.tx1) + TimeValue(uf2.tx2) Fname = Dir(ThisWorkbook.Path & "*.xls*") FnameMsg = "" Do While Fname <> "" If Fname <> ThisWorkbook.Name Then On Error Resume Next Open ThisWorkbook.Path & "\" & Fname For Append As #1 Close #1 'ブックが開かれている場合 If Err.Number > 0 Then 'ファイル名をMsgBox用メッセージに追記 FnameMsg = FnameMsg & Fname & vbCrLf Else Set srcSH = Workbooks.Open(ThisWorkbook.Path & "\" & Fname).Worksheets(1) srcSH.AutoFilterMode = False Dim i As Long For i = 11 To Cells(Rows.Count, 4).End(xlUp).Row If Cells(i, 3) = "" Then Cells(i, 4).Copy Cells(i, 4) End If Next i Range("A10").AutoFilter Field:=2, Criteria1:="<=" & CStr(dEnd) Range("A10").AutoFilter Field:=8, Criteria1:="=" If srcSH.AutoFilter.Range.Cells(1).Row <> srcSH.Cells(srcSH.Rows.Count, "D").End(xlUp).Row Then With srcSH.AutoFilter.Range Intersect(.Cells, .Offset(1), srcSH.Range("H:H"), .SpecialCells(xlCellTypeVisible)).Value = "◎" Intersect(.Cells, .Offset(1)).Copy dstRNG With dstRNG.Parent Set dstRNG = .Cells(.Rows.Count, "D").End(xlUp).Offset(1, -3) End With End With End If srcSH.AutoFilterMode = False srcSH.Parent.Save srcSH.Parent.Close End If End If Fname = Dir() Loop Application.ScreenUpdating = True FnameMsg FnameList Unload uf2 End Sub ```
yureighost

2020/03/09 05:47

すいません。 メッセージ出力部分のみ私のコーディングミスです。 修正ソースのように記述していただければ出力できます。
ichigo15

2020/03/16 06:04

確認が遅くなりまして申し訳ございません。 無事にできるようになりました。 ご指導いただきまして感謝いたします。
guest

0

投稿2020/03/09 00:57

ttyp03

総合スコア16996

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ichigo15

2020/03/09 02:11

申し訳ございません。 誰が開いているか知りたいのではなく、開いていないファイルだけにマクロを実行させたいのです。
ttyp03

2020/03/09 02:15

なので、誰かが開いている開いていないの判定方法を回答したのですが。。。
ichigo15

2020/03/09 03:36

申し訳ございません。 せっかくですが今回は開いていないファイルだけにマクロを実行させたいのです。 これはユーザー情報を取得する方法ですよね? ユーザーは関係ないのです、どのファイルが開かれているかどうかです。
ttyp03

2020/03/09 04:07

共有しているExcelブックファイルを別の誰かが開いているか開いていないかの判定方法ではないのですか? その判定には開いている人のユーザー情報が必要で、別の誰かが開いていないのであれば、ユーザー情報はおそらく自分だけが取得できることになるので、それで判定してはどうでしょうか、という趣旨で回答したのですが。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問