お疲れ様です。
はざまです。
今回は、社内でよくある作業をExcel VBAで自動化していきます。
せっかくなので、自動化する際に自分がどう考えているかも一緒に共有していきますね。
自動化する際の考え方
自動化をする際、自分はそんなに難しいことは考えていません。
基本4つのステップを踏めば簡単に自動化できます。
【自動化に向けた4ステップ】
【1.作業整理】
自動化したい作業を箇条書きで書き出す。
★ポイント：なるべく1クリック1作業として箇条書きすることを意識します。
【2.作業のグループ化】
自動化したい作業を、グループ化する。
★ポイント：作業開始前と終了後で状態が変わらないよう作業をグループ化します。
【3.ツール作成】
グループごとに、VBAを書く。
★ポイント：VBAを書く際、なるべくコメントを入れます。
【4.テスト・デバッグ】
ツールを実際に動かして想定通りに動くか確認する。
★ポイント：ループ、分岐にブレークポイントを設定します。
はい、では実際にステップに沿って行きますね。
【1.作業整理】
まずは作業整理です。
自動化したい作業がどういった作業なのかをまずは整理します。
よくあるのが、複数のExcelファイルの特定シートの特定セルの情報を整理する作業ですね。
※こんな感じで今月の作業実績を収集して一枚のシートにまとめてる作業とかありますよね。
ちなみに、自分にとってこの作業は苦痛でした。(今も苦痛)
やっていくうちになんだか時間の浪費をしている感じがしてきて、だんだんおざなりになっていくんですよね。。
※そしてミスして怒られるのが一連の流れです。
とまあ、そんな感じで作業整理してみました。
なるべく1クリック1作業を意識して書き出すと以下のように整理できましたね。
・フォルダを開く
※以下処理をファイル数分行う
・コピー対象ファイルを開く
・コピー対象対象シートを開く
・コピー対象セルを選択する
・選択範囲をコピーする。
・コピー先のファイルを開く
・コピー先シートを開く
・貼り付け先セルを選択
・貼り付け
・コピー元ファイルを閉じる
※上記作業をコピー対象ファイル分繰り返す
割と作業が少し抜けてたりはするかもですが、そこはスルーしておいてください。
はい、作業整理終わり。
【2.作業のグループ化】
続いてグループ化ですね。
作業開始前と終了後で状態が変わらないよう作業をグループ化していきます。
★部品2
・コピー対象対象シートを開く
・コピー対象セルを選択する。
・選択範囲をコピーする。
・コピー先のファイルを開く
・コピー先シートを開く
・貼り付け先セルを選択
・貼り付け
★部品1
・フォルダを開く
●以下処理をファイル数分行う
・フォルダ配下のファイルを順に開く
・部品2の処理を行う
・ファイルを閉じる
・終了
おお～～？
なんか簡単に見えてきませんでした？
ではここからツール化していきましょう。
【3.ツール作成】
3-1.事前準備
ツール作成にはVBEを使う必要があるので、起動しておきましょう。
まずExcelを開いて以下手順を行います。
・リボンの[開発]>[Visual Basic]をクリックする
・左にVBAProjectがあるので、開いているExcelファイル名のプロジェクトを右クリック。[挿入(N)]>[標準モジュール(M)]をクリックする。
※こんな感じで標準モジュールが開かれたらOK（はざまの画面だと黒色ですが、特に気にしないでください。皆さんは白色の画面が出ていると思います。）
3-2.ツール作成
はい、いよいよツール作成です。
ツールはグループごとに作っていきます。
どこから作れば良いかはお任せしますが、自分は大枠から作ります。※今回だと「部品1」ですね。
そんなわけで「部品1」を作っていきましょう。
部品1作成
今回は(はざまの趣味ですが)ツール実行したらフォルダ選択画面に入って、フォルダを選択したら選択したフォルダ配下のファイルだけ処理をしてくれるようにします。
まずはフォルダを開く部分として、フォルダ選択ポップアップが出るツールを作りましょう。
以下になりますね。
Sub SelectFolder()
'■変数宣言
Dim selectedFolder As String '選択されたフォルダ
'■フォルダを開く(ダイアログを表示してフォルダを選択)
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "フォルダを選択してください"
.ButtonName = "選択"
'■マクロを実行しているワークブックのパスを初期値として設定
.InitialFileName = ThisWorkbook.Path
If .Show = -1 Then
'■選択されたフォルダを"selectedFolder"変数に格納
selectedFolder = .SelectedItems(1)
Else
'■キャンセルされた場合は処理を終了
Exit Sub
End If
End With
'■選択されたフォルダをメッセージボックスで出力
Magbox selectedFolder
End Subは？
となった方すみません、いったん何も考えずに上記コードを先ほどの標準モジュールにコピペしてください。
そして、コメント（先頭にシングルコーテーションが入っている文字列）に軽く目を通してください。
多分大まかにやりたいことはわかると思います。
大まかに理解できたなら後は実際に動かして理解していきましょう。（できなくても動かしていけばなんとなく理解できるようになりますよ。）
※コピペした結果はこんな感じ
貼り付けられたら、上の帯にある「▸」をクリック、もしくは[F5]キーを押しましょう。
すると、ツールが実行されます。
フォルダ選択画面に入ります。
そうしたら、任意のフォルダを選択して「OK」をクリックしてください。
選択したフォルダのパスがポップアップで出力されます。
上述の通りに実行できたのであればあと一息です。
選択されたフォルダパス配下のファイルが順々に開かれるようにしましょう。
そうするとこんな感じになります。(赤ラインマーカが追加した部分です。)
Sub SelectFolder()
'■変数宣言
Dim selectedFolder As String '選択されたフォルダ
'■ダイアログを表示してフォルダを選択
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "フォルダを選択してください"
.ButtonName = "選択"
'■マクロを実行しているワークブックのパスを初期値として設定
.InitialFileName = ThisWorkbook.Path
If .Show = -1 Then
'■選択されたフォルダを"selectedFolder"変数に格納
selectedFolder = .SelectedItems(1)
Else
'■キャンセルされた場合は処理を終了
Exit Sub
End If
End With
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
' ■FileSystemObjectを作成
Set objFSO = CreateObject("Scripting.FileSystemObject")
' ■フォルダオブジェクトを取得
Set objFolder = objFSO.GetFolder(selectedFolder)
' ■フォルダ内のファイルを順に取得
' ★作業をコピー対象ファイル分繰り返す。
For Each objFile In objFolder.Files
'■ファイルを開く
Set wb = Workbooks.Open(objFile)
'■選択されたフォルダ配下のファイルを順々にメッセージボックスで出力(今後は部品2の処理に置き換える)
MsgBox objFile.Path
'■ファイルを閉じる
wb.Close
Next objFile
' ■オブジェクトを解放
Set objFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
End Subこれで「部品2」はほぼ完成です。
あとは、「部品1」を作って組み合わせていきましょう。
部品2作成
部品2ですが、以下の処理をしようとしていました。
・コピー対象ファイルを開く
・コピー対象対象シートを開く
・コピー対象セルを選択する。
・選択範囲をコピーする。
・コピー先のファイルを開く
・コピー先シートを開く
・貼り付け先セルを選択
・貼り付け
・コピー元ファイルを閉じる。
ここからツールを作って行くわけですが、まずは上記処理を標準モジュールにコメントとして貼り付けるのをおすすめします。
※コメントとは、モジュール内に記載できる処理対象外の文字列です。
どういった処理をしているのか等の情報をメモとして残したりするのに使ったりします。
コメント化するには、文字の先頭にシングルコーテーション「’」を付けます。
こんな感じですね。
'■コピー対象対象シートを開く
'■コピー対象セルを選択する。
'■選択範囲をコピーする。
'■コピー先のファイルを開く
'■コピー先シートを開く
'■貼り付け先セルを選択
'■貼り付けはい、そうしたらそれぞれのコメントごとに処理を書いていきます。
Dim C_SheetName As String '■コピー対象シート名
Dim C_CellName As String '■コピー対象セル名
Dim P_BookName As String '■貼り付け先エクセルファイル名
Dim P_SheetName As String '■貼り付け先シート名
Dim P_CellName As String '■貼り付け先セル名
'■パラメータ取得
C_SheetName = "作業実績"
C_CellName = "B2:E30"
P_BookName = "集約マクロ.xlsm"
P_SheetName = "転記先"
P_CellName = "B2" '
'■Workbook内の各Worksheetをループで開く
For Each ws In wb.Worksheets
'■シートをアクティブにする
ws.Activate
' ■シート名がコピー対象シート名、もしくはコピー対象シート名の文字列を含む場合、以下処理をする
If InStr(ws.Name, SheetName) > 0 Then
'■選択範囲をコピーする。
ws.Range(C_CellName).Copy
'■コピー先のファイルを開く
'■コピー先シートを開く
Workbooks(P_BookName).Worksheets(P_SheetName).Activate
'■貼り付け先セルにすでに値が入っているかチェック、値が入っていたら値が入っていないセルを指定する処理を入れる
If Range(P_CellName).Value <> "" Then
'■貼り付け先セル上でCtl + ↓ を実行し、さらに1行下に移動したセルのアドレスを取得
'■貼り付け先セルを選択
P_CellName = Range(P_CellName).End(xlDown).Offset(1, 0).Address
End If
'■貼り付け
Range(P_CellName).PasteSpecial Paste:=xlPasteAll
End If
Next ws書いていくうちにこの処理できないなーとなった場合は、違う処理に置き換えてください。
上記でいうと、
‘■コピー対象対象シートを開く
を
‘■シートをアクティブにする
‘■シート名がコピー対象シート名、もしくはコピー対象シート名の文字列を含む場合、以下処理をする
の2処理に置き換えています。
はい、そうしたら部品2ができました。
できたら部品1と組み合わせましょう。
Sub SelectFolder()
'■変数宣言
Dim selectedFolder As String '選択されたフォルダ
'■ダイアログを表示してフォルダを選択
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "フォルダを選択してください"
.ButtonName = "選択"
'■マクロを実行しているワークブックのパスを初期値として設定
.InitialFileName = ThisWorkbook.Path
If .Show = -1 Then
'■選択されたフォルダを"selectedFolder"変数に格納
selectedFolder = .SelectedItems(1)
Else
'■キャンセルされた場合は処理を終了
Exit Sub
End If
End With
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
' ■FileSystemObjectを作成
Set objFSO = CreateObject("Scripting.FileSystemObject")
' ■フォルダオブジェクトを取得
Set objFolder = objFSO.GetFolder(selectedFolder)
' ■フォルダ内のファイルを順に取得
' ★作業をコピー対象ファイル分繰り返す。
For Each objFile In objFolder.Files
'■ファイルを開く
Set wb = Workbooks.Open(objFile)
'----------------------------------以下部品2----------------------------------
Dim C_SheetName As String '■コピー対象シート名
Dim C_CellName As String '■コピー対象セル名
Dim P_BookName As String '■貼り付け先エクセルファイル名
Dim P_SheetName As String '■貼り付け先シート名
Dim P_CellName As String '■貼り付け先セル名
'■パラメータ取得
C_SheetName = "作業実績"
C_CellName = "B2:E30"
P_BookName = "集約マクロ.xlsm"
P_SheetName = "転記先"
P_CellName = "B2" '
'■Workbook内の各Worksheetをループで開く
For Each ws In wb.Worksheets
'■シートをアクティブにする
ws.Activate
' ■シート名がコピー対象シート名、もしくはコピー対象シート名の文字列を含む場合、以下処理をする
If InStr(ws.Name, SheetName) > 0 Then
'■指定されたセルをコピー
ws.Range(C_CellName).Copy
'■貼り付け先シートをアクティブにする
Workbooks(P_BookName).Worksheets(P_SheetName).Activate
'■貼り付け先セルにすでに値が入っているかチェック、値が入っていたら値が入っていないセルを指定する処理を入れる
If Range(P_CellName).Value <> "" Then
'■貼り付け先セル上でCtl + ↓ を実行し、さらに1行下に移動したセルのアドレスを取得
P_CellName = Range(P_CellName).End(xlDown).Offset(1, 0).Address
End If
'■上記処理で指定されたセルに対して、値貼り付け
Range(P_CellName).PasteSpecial Paste:=xlPasteAll
End If
Next ws
'-----------------------------------------------------------------------------
'■ファイルを閉じる
wb.Close
Next objFile
' ■オブジェクトを解放
Set objFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
End Sub
こんな感じですね。
はい、これでツールの作成まで終わりました。
デバッグは次回に回しますね。（エネルギー切れ）
見てくれてありがとうございました。
ではまた。
コメント