マスタを更新する作業ってありませんか?
これは何月のマスタとか、これは○○でとか、同じようなものを毎回いろんなブックにコピーしていかないといけないことがあります。
これを解消できないか考えたマクロです。(パワークエリに近いかな)
目次
フォルダ内のブックをまとめて処理
Option Explicit
Sub test()
Application.ScreenUpdating = False
Dim a, b
Dim WB As Workbook
Dim buf As String
Dim folderPath As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
folderPath = .SelectedItems(1)
End If
End With
'Dir関数でファイルを確認
buf = Dir(folderPath & "\*.xls")
'フォルダ内にブックがなければ終了
If buf = "" Then Exit Sub
Do
If buf Like "*○○*" Then
'ブック名に○○が含まれて場合に挙動
Set WB = Workbooks.Open(Filename:=folderPath & "\" & buf)
Workbooks("Book").Worksheets("○○").UsedRange.ClearContents
Set b = Workbooks("Book").Worksheets("○○").Range("A1")
WB.Close
End If
If buf Like "*△△*" Then
'ブック名に△△が含まれて場合に挙動
Set WB = Workbooks.Open(Filename:=folderPath & "\" & buf)
Workbooks("Book").Worksheets("△△").UsedRange.ClearContents
Set b = Workbooks("Book").Worksheets("△△").Range("A1")
WB.Close
End If
'次のブックのファイル名を取得
buf = Dir()
Loop While buf <> ""
Application.ScreenUpdating = true
End Sub
条件分岐はSelectのほうが簡単そうですが、likeが使いずらいのでIfでやっています。
条件分岐後はクラスモジュールを利用すると見栄えがいいと思います
解説的なもの
Application.ScreenUpdating
画面を止めておくやつです。
どっちでもいいと思います。
お好みで止めてください。
フォルダのパスを取得
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
folderPath = .SelectedItems(1)
End If
End With
この部分でフォルダパスを取得しています。
ダイアログを開いて利用者に選ばせる方法です。
これがあるとないので、あとからのクレームを防げるので必須だと思います。
フォルダ名変わったとかでエラーを起こして文句言われること多いですからね。
Dir関数
Dir関数は、ファイルが存在するかどうかを判定する関数なんですが、引数を省略すると、まだ返していないファイル名を順に返すという特性があります。
buf = Dir(folderPath & “\*.xls”)で一度指定して返すと、以降はbuf = Dir()これだけで、同じフォルダ内でまだ返していないファイルを順番に返してくれるのです。
おわり
コピーなどは
こちらを利用しています。
コメント