前提
サーバー上にあるフォルダ内の複数のブックより条件に応じて抽出をします。
問題点
今は時間を指定して抽出作業中はブックを開かないようにしてもらってます。
ですが、ブックを開いていけないことを忘れて開いてしまう人がいます。
そうすると、既に抽出したものは次回抽出されないようにセルに"◎"を入れるように
してますがこの"◎"が入力されないので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
回答4件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2020/03/09 03:45
2020/03/09 07:01