はじめに
業務の自動化や効率化のためにVBAを利用しますが、作業手順が変わったりするとVBAもメンテナンスが必要になります。
常にVBAの分かる人がいればいいのですが、作業担当者の変更などで「VBAが分かる人がいなくなってしまう」事も有るかと思います。
そんな時に作業手順の変更があると、いままで使われていたVBAのメンテナンスが行えず、結局VBAが使われなくなり手動にもどる、といったことが起きてしまうかもしれません。
そこで、VBAがわからない人でもVisual Basic画面を表示させなくても、シート上でメンテナンスできるように
作業手順をエクセルのシートに書くと、その手順どおりに実行してくるようなマクロを作ってみました。
完成イメージ
シートの作業手順を書き換え「フィルターをかける」→「絞り込まれたデータを削除」→「フィルター解除」→「名前を付けて保存」を実行しています。
※分かりやすいように1手順ごとに止めながら実行しています。実際の動作はほぼ一瞬で完了します。
実装の流れ
処理ごとにFunction化する
例えばフィルターをかける処理であれば
「A1」から始まる表の「C」列目を「鈴木」のみでフィルターしたいときは
Range("A1").AutoFilter 3, "=" & "鈴木"
と記述します。
なので「表の開始セル」,「対象列」,「文字列」の３つを引数で指定するようにすればFunction(関数)化出来ます。
Function フィルター_値に等しい(argArr)
'表の開始セル, 対象列, 対象文字列の変数宣言
Dim cellAddr As String
Dim tgtCol As String
Dim tgtStr As String
'Arrayで渡された値を変数に割り当て
cellAddr = argArr(0)
tgtCol = argArr(1)
tgtCol = Cells(1, tgtCol).Column '英字から数値へ変換 例)C→3
tgtStr = argArr(2)
'フィルター処理
Range(cellAddr).AutoFilter tgtCol, "=" & tgtStr
End Function
※フィルター以外の処理で引数の数が可変しても対応できるよう配列で引数を渡します。
このように処理をひとつひとつFunction化していきます。
処理ごとのFunctionをメインで呼び出す
そしてこのFunctionをメインのSubで引数を設定して呼び出します。
Sub ファンクション呼び出し()
'配列の設定
Dim argArr() As Variant
argArr = Array("A1", "C", "鈴木")
'Functionの呼び出し
Application.Run "フィルター_値に等しい", argArr
End Sub
これで、cellAddrに「A1」、 tgtColに「3」、tgtStrに「鈴木」が入り
Range("A1").AutoFilter 3, "=" & "鈴木"
が実行されるようになります。
ここまでの
・配列で引数を受け取るFunction
・引数を設定してFunctionを呼び出すSub
がこのマクロの基本で、Functionを増やしていくだけで機能を追加していくことが出来ます。
以下から、引数の設定とFunctionの呼び出しをシートに記載して設定出来るようにしていきます。
Function名と引数をシートから設定出来るようにする
SubでFunctionを呼び出す時にFunction名と、引数の配列を設定しています。
argArr = Array("A1", "C", "鈴木") '配列
Application.Run "フィルター_値に等しい", argArr 'Function名, 引数
このFunction名と引数を記載する「作業手順」シートを用意し、VBAで読み込めるようにします。
A列にFunction(作業)名、B列以降に引数を書くようにします。
行ごとに読み込んで、引数の数が可変しても対応出来るようにしたのがこちら
Sub ファンクション呼び出し()
'配列の用意
Dim tmpArr() As Variant
Dim argArr() As Variant
'1列目から最後の引数までtmpArrに入れる
tmpArr = Range(Cells(2, 1), Cells(2, 1).End(xlToRight)).Value
'要素の 2 番目から引数配列に入れる設定
Dim arrIndex As Long
arrIndex = 2
'tmpArrの二次元配列からargArrの一次元配列に入れる
ReDim argArr(UBound(tmpArr, 2) - arrIndex)
Dim i As Long
For i = 0 To UBound(tmpArr, 2) - arrIndex
argArr(i) = tmpArr(1, i + arrIndex)
Next i
'tmpArr(1,1)でFunction名指定、引数配列を渡してFunction呼び出し
Application.Run tmpArr(1, 1), argArr
End Sub
処理の解説
tmpArr = Range(Cells(2, 1), Cells(2, 1).End(xlToRight)).Value
2行目の1列目から、2行目のデータのある最後の列までを2次元配列に入れる
| tmpArr | 1 | 2 | 3 | 4 |
|---|---|---|---|---|
| 1 | "フィルター_値に等しい" | "A1" | "C" | "鈴木" |
'要素の 2 番目から引数配列に入れる設定
arrIndex = 2
ReDim argArr(UBound(tmpArr, 2) - arrIndex)
UBound(tmpArr, 2)
tmpArr二次元目(横方向)の最大インデックスを取得 → 4
「4 - 2 = 2」のReDim argArr(2)で一次元配列を用意する。
一次元配列は「0」から始まるので0,1,2の３つの要素を入れることが出来る。
| 0 | 1 | 2 | |
|---|---|---|---|
| argArr(2) |
For i = 0 To UBound(tmpArr, 2) - arrIndex
argArr(i) = tmpArr(1, arrIndex + i )
Next i
Forが0,1,2の3回繰り返される。
| tmpArr | 1 | 2 | 3 | 4 |
|---|---|---|---|---|
| 1 | "フィルター_値に等しい" | "A1" | "C" | "鈴木" |
↓tmpArr(1, 2)から順にargArrに入れていく。
| 1回目 | 0 | 1 | 2 |
|---|---|---|---|
| argArr | "A1" |
| 2回目 | 0 | 1 | 2 |
|---|---|---|---|
| argArr | "A1" | "C" |
| 3回目 | 0 | 1 | 2 |
|---|---|---|---|
| argArr | "A1" | "C" | "鈴木" |
これで引数用の配列が完成です。
対象ブック、シートの指定
このままだと「作業手順」シートに処理がかかるため、処理対象のブックとシートを指定出来るようにします。
処理対象ブックとシートを指定する「設定」シートを用意します。
「設定」シートに記載されたブック・シートのオブジェクトを取得します。
併せて「作業手順」シートも繰り返し読み込むので取得します。
'処理対象ブック・シートをFunctionで利用できるようsubの外に宣言
Dim tgtWb As Workbook
Dim tgtWs As Worksheet
Sub ファンクション呼び出し()
'本ブックと「作業手順」シートのオブジェクト取得
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Sheets("作業手順")
'処理対象ブック・シートの設定
Set tgtWb = Workbooks.Open(wb.Sheets("設定").Range("B1").Value)
Set tgtWs = tgtWb.Sheets(wb.Sheets("設定").Range("B2").Value)
'配列の用意
Dim tmpArr() As Variant
Dim argArr() As Variant
'1列目から最後の引数までtmpArrに入れる
tmpArr = ws.Range(ws.Cells(2, 1), ws.Cells(2, 1).End(xlToRight)).Value
'要素の 2 番目から引数配列に入れる
Dim arrIndex As Long
arrIndex = 2
'tmpArrの二次元配列からargArrの一次元配列に入れる
ReDim argArr(UBound(tmpArr, 2) - arrIndex)
Dim i As Long
For i = 0 To UBound(tmpArr, 2) - arrIndex
argArr(i) = tmpArr(1, arrIndex + i)
Next i
'tmpArr(1,1)でFunction名指定、引数配列を渡してFunction呼び出し
Application.Run tmpArr(1, 1), argArr
End Sub
'------------------------------------------------------------------
Function フィルター_値に等しい(argArr)
'表の開始セル, 対象列, 対象文字列の変数設定
Dim cellAddr As String
Dim tgtCol As String
Dim tgtStr As String
'Arrayで渡された値を変数に割り当て
cellAddr = argArr(0)
tgtCol = argArr(1)
tgtCol = Cells(1, tgtCol).Column '英字から数値へ変換 例)C→3
tgtStr = argArr(2)
'フィルター処理
tgtWs.Range(cellAddr).AutoFilter tgtCol, "=" & tgtStr
End Function
Functionでもしっかり、不具合防止のため処理対象シートを指定するようにします。
これで処理対象ブック・シートへ処理がされるようになりました。
作業手順の行数分繰り返し出来るようにする
今のままだと、「作業手順」の2行目の処理しか行われないため
Function実行後、「作業手順」の次の行を読み込み出来るようにします。
'処理対象ブック・シートをFunctionで利用できるよう宣言
Dim tgtWb As Workbook
Dim tgtWs As Worksheet
Sub ファンクション呼び出し()
'本ブックと「作業手順」シートのオブジェクト取得
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Sheets("作業手順")
'処理対象ブック・シートの設定
Set tgtWb = Workbooks.Open(wb.Sheets("設定").Range("B1").Value)
Set tgtWs = tgtWb.Sheets(wb.Sheets("設定").Range("B2").Value)
'配列の用意
Dim tmpArr() As Variant
Dim argArr() As Variant
'二次元→一次元配列変換時のループ用
Dim i As Long
'初期設定--------------------------------------------------------
'作業手順 2 行目からスタート
Dim row As Long
row = 2
'要素の 2 番目から引数配列に入れる設定
Dim arrIndex As Long
arrIndex = 2
'処理開始-------------------------------------------------------
'「作業手順」シートの処理名が空になるまで繰り返し
Do While ws.Cells(row, 1) <> ""
'配列の初期化
tmpArr = Array()
argArr = Array()
'1列目から最後の引数までtmpArrに入れる
tmpArr = ws.Range(ws.Cells(row, 1), ws.Cells(row, 1).End(xlToRight)).Value
'tmpArr二次元配列からargArr一次元配列に入れる
ReDim argArr(UBound(tmpArr, 2) - arrIndex)
For i = 0 To UBound(tmpArr, 2) - arrIndex
argArr(i) = tmpArr(1, arrIndex + i)
Next i
'tmpArr(1,1)でFunction名指定、引数配列を渡してFunction呼び出し
Application.Run tmpArr(1, 1), argArr
row = row + 1
Loop
End Sub
これでSubの部分は完成です。
作業手順シートへの設定方法を明記する
「作業手順」シートに正しいFunction(作業)名、引数を記載しないとエラーになってしまうので
正しく入力出来るようプルダウンでFunction(作業)名を指定できるようにし、
引数の設定方法も分かるように「機能一覧」シートを用意します。
完成
完成したのがこちら ※行数の都合でFunctionは2つのみ記載しています。
これだとFunctionを2つしか記載していないので、「値に等しいデータでフィルターする」機能と「上書き保存」の機能しか有りませんが、その他のフィルターや独自の機能をFunctionで追記していくだけで、処理の幅はかなり広がります。
'処理対象ブック・シートをFunctionで利用できるようSubの外で宣言
Dim tgtWb As Workbook
Dim tgtWs As Worksheet
Sub ファンクション呼び出し()
'本ブックと「作業手順」シートのオブジェクト取得
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Sheets("作業手順")
'処理対象ブック・シートの設定
Set tgtWb = Workbooks.Open(wb.Sheets("設定").Range("B1").Value)
Set tgtWs = tgtWb.Sheets(wb.Sheets("設定").Range("B2").Value)
'配列の用意
Dim tmpArr() As Variant
Dim argArr() As Variant
'二次元→一次元配列変換時のループ用
Dim i As Long
'初期設定--------------------------------------------------------
'作業手順 2 行目からスタート
Dim row As Long
row = 2
'要素の 2 番目から引数配列に入れる
Dim arrIndex As Long
arrIndex = 2
'処理開始-------------------------------------------------------
'「作業手順」シートの作業名が空になるまで繰り返し
Do While ws.Cells(row, 1) <> ""
'配列の初期化
tmpArr = Array()
argArr = Array()
'1列目から最後の引数までtmpArrに入れる
tmpArr = ws.Range(ws.Cells(row, 1), ws.Cells(row, 1).End(xlToRight)).Value
'tmpArrの二次元配列からargArrの一次元配列に入れる
ReDim argArr(UBound(tmpArr, 2) - arrIndex)
For i = 0 To UBound(tmpArr, 2) - arrIndex
argArr(i) = tmpArr(1, arrIndex + i)
Next i
'tmpArr(1,1)でFunction名指定、引数配列を渡してFunction呼び出し
Application.Run tmpArr(1, 1), argArr
row = row + 1
Loop
End Sub
'-------------------------------------------------------------------
Function フィルター_値に等しい(argArr)
'表の開始セル, 対象列, 対象文字列の変数設定
Dim cellAddr As String
Dim tgtCol As String
Dim tgtStr As String
'Arrayで渡された値を変数に割り当て
cellAddr = argArr(0)
tgtCol = argArr(1)
tgtCol = Cells(1, tgtCol).Column '英字から数値へ変換 例)C→3
tgtStr = argArr(2)
'フィルター処理
tgtWs.Range(cellAddr).AutoFilter tgtCol, "=" & tgtStr
End Function
'-------------------------------------------------------------------
Function 処理対象ブックを上書き保存(argArr)
'上書き保存
tgtWb.Save
End Function
おわりに
長くなりましたが、とりあえず
・Function名と引数をシートに記載するとFunctionを順に呼び出せる
・引数を配列で受け取るFunctionを作れば、機能を追加できる
そんなマクロが出来ました。
今回は、処理対象を1つのブック・シートだけに限定していますが、引数でブック・シートを指定して(シートへの記述が多くなりますが)どんな状況にも対応できるような作りにも出来そうです。(そのためarrIndexで二次元配列のn番目から一次元配列に入れられるようにしています。)
エラー処理も未実装で機能もまだまだ不足していますので、今後追加して実用性を高めていきたいと思います。