はじめに

職場でデザインシート（環境変数シート）の更新業務を任されました。
そこで、デザインシートの該当箇所に正しくマーク「●」が入力されているかチェックするマクロを作成しました。
追加項目が少なければ手作業でもよかったのですが、当分の間更新していなかったようで700個ほど追加が必要とのこと。。。
チェック漏れや入力ミスを無くすため作業を機械的にチェックすることにしました。

今回実施した更新業務

・追加項目をデザインシートに記入
・追加対象シート作成
・自動チェックマクロ作成
・マクロ実行結果と入力結果の照合
・差異がある箇所を確認して訂正
→差異が無くなればチェック完了とする

デザインシート

用意したもの

以下、追加対象一覧たるものを作成しました。新たに追加する環境変数たちです。
この表を使ってチェックツールを作成していきます。

マクロ

Sub 追加対象チェックマクロ環境シート用()
    Dim hs As Worksheet, tk As Worksheet
    Dim kkh As String, sst As String, usr As String
    Dim i As Long, j As Long, LR As Long
    
       
    Set hs = Sheets("環境")                '環境シートをhsで定義
    Set tk = Sheets("追加対象")            '追加対象シートをtkで定義
    
    LR = tk.Cells(Rows.Count, 1).End(xlUp).Row  '最終行
    
    '最終行まで処理を繰り返す
    For i = 2 To LR
    
    kkh = tk.Cells(i, 2).Value              '環境変数名
    stt = tk.Cells(i, 3).Value              '設定値
    usr = tk.Cells(i, 4).Value              'ユーザー名
    ser = tk.Cells(i, 5).Value              'サーバ名
    
    '環境シートの環境変数名をkkhでフィルター
    hs.Range("A1").CurrentRegion.AutoFilter _
     field:=3, _
     Criteria1:=kkh
    'データがなければLoopLast:へワープ
    If WorksheetFunction.Subtotal(3, Range("A:A")) < 2 Then
        GoTo LoopLast
    End If

    '環境シートの設定値をsttでフィルター
    hs.Range("A1").CurrentRegion.AutoFilter _
     field:=4, _
     Criteria1:=stt
    'データがなければLoopLast:へワープ
    If WorksheetFunction.Subtotal(3, Range("A:A")) < 2 Then
        GoTo LoopLast
    End If
     
    '環境シートのユーザ名をusrでフィルター
    hs.Range("A1").CurrentRegion.AutoFilter _
     field:=5, _
     Criteria1:=usr
    'データがなければLoopLast:へワープ
    If WorksheetFunction.Subtotal(3, Range("A:A")) < 2 Then
        GoTo LoopLast
    End If
     
    'serが"インターネットサーバ"なら色を付ける
    If tk.Cells(i, 5) = "インターネットサーバ" Then
    Range("A1").Resize(Range("A1"). _
       CurrentRegion.Rows.Count - 2).Offset(2, 5).Interior.Color = vbYellow
        
     'serが"Web/APサーバ"なら色を付ける
     ElseIf _
       tk.Cells(i, 5) = "Web/APサーバ" Then
    Range("A1").Resize(Range("A1"). _
       CurrentRegion.Rows.Count - 2).Offset(2, 6).Interior.Color = vbYellow
       
     'serが"バッチサーバ"なら色を付ける
     ElseIf _
       tk.Cells(i, 5) = "バッチサーバ" Then
    Range("A1").Resize(Range("A1"). _
       CurrentRegion.Rows.Count - 2).Offset(2, 7).Interior.Color = vbYellow
       
     'serが"運用サーバ"なら色を付ける
     ElseIf _
       tk.Cells(i, 5) = "運用サーバ" Then
    Range("A1").Resize(Range("A1"). _
       CurrentRegion.Rows.Count - 2).Offset(2, 8).Interior.Color = vbYellow
       
     'serが"メールサーバ"なら色を付ける
     ElseIf _
       tk.Cells(i, 5) = "メールサーバ" Then
    Range("A1").Resize(Range("A1"). _
       CurrentRegion.Rows.Count - 2).Offset(2, 9).Interior.Color = vbYellow
       
     'serが"DBサーバ"なら色を付ける
     ElseIf _
       tk.Cells(i, 5) = "DBサーバ" Then
    Range("A1").Resize(Range("A1"). _
       CurrentRegion.Rows.Count - 2).Offset(2, 10).Interior.Color = vbYellow
    End If
    
    '追加対象シートのF列にチェック結果が正常ならセルを水色に変えて「OK」と表示
    tk.Cells(i, 6).Interior.Color = vbYellow
    tk.Cells(i, 6).Value = "OK"
     
LoopLast:
    
    '追加対象シートのF列が空白なら以下msgを表示
    If tk.Cells(i, 6).Value = "" Then
        tk.Cells(i, 6).Value = "環境シートの確認の必要あり"
    End If
    
    'フィルター後に２行以上存在していたら色をつける
     If WorksheetFunction.Subtotal(3, Range("A:A")) > 2 Then
       Range("A1").Resize(Range("A1"). _
       CurrentRegion.Rows.Count - 2).Offset(2, 0).Interior.Color = vbYellow
    End If
    
     '絞り込みクリア
     hs.ShowAllData
    
    Next

     
     
End Sub

概要

追加対象シートの「環境変数名」でフィルタを実行する、次に「設定値」でフィルタを実行する、次に「ユーザ名」でフィルタを実行する。
全て無事にフィルタができたら、サーバ名を判定して該当セルに色をつけていく。
色をつけたら、追加対象シートのF列に「OK」と入力する。
フィルタで絞ることができなかった場合は追加対象シートのF列に「OK」と記載せずに「環境シートの確認の必要あり」と記入し次へ進む。
フィルタ後に重複がある場合は環境シートのA列（No.列）に色付けをする。

解説

【変数の宣言】
まず、DimとSetでそれぞれ変数の宣言をします。

Dim hs As Worksheet, tk As Worksheet
Dim kkh As String, sst As String, usr As String
Dim i As Long, j As Long, LR As Long

Set hs = Sheets("環境") 
Set tk = Sheets("追加対象") 

【LRを定義】
続いて、変数LRにtk.Cells(Rows.Count, 1).End(xlUp).Rowを定義します。

LR = tk.Cells(Rows.Count, 1).End(xlUp).Row

↑意味は「A列の最終行を取得」。（）の中の数字が1なのでA列を基準とする。
この（）の中の数字が２の場合はB列を基準に最終行を取得。

【繰り返す回数】

For i = 2 To LR

↑追加対象シートにて２行目から値があるので２。LRは先ほど定義した最終行。
2行目からA列の最終行まで繰り返します。

【変数の定義】
対象のセルは「tk.」なので追加対象シートのセルのことを指しています。
環境変数名をkkh、設定値をstt、ユーザ名をsur、サーバ名をserを定義する。

kkh = tk.Cells(i, 2).Value
stt = tk.Cells(i, 3).Value
usr = tk.Cells(i, 4).Value
ser = tk.Cells(i, 5).Value

【環境シートにてフィルタを実行＆GoTo LoopLast】
追加対象シートの値を使ってフィルターしていきます。
まずは以下のように環境変数名でフィルターします。

    hs.Range("A1").CurrentRegion.AutoFilter _
     field:=3, _
     Criteria1:=kkh

次にデータがなければLoopLast:へワープする手順をいれています。
ここでいう「データがない」とはフィルタで絞り込むことができなかった状態のことを指しています。※画像参照

データがない場合色は付けられないため以下のようにGoTo LoopLastを使って特定の場所へループさせます。

If WorksheetFunction.Subtotal(3, Range("A:A")) < 2 Then
　GoTo LoopLast
End If

↑ GoTo LoopLastはLoopLast:まで処理をとばしてくれます。

そして、絞り込んだ結果が何件あるか集計したいときに役立つのがワークシート関数の
SUBTOTAL関数です。

「Subtotal(3, Range("A:A"))」の３という引数は「データの個数を求める」という意味です。
１なら平均値、２なら数値の個数といった感じで引数の数字で求めるものが変わってきます。
Range("A:A")は「対象はA列」ということです。

そして、「If WorksheetFunction.Subtotal(3, Range("A:A")) < 2 Thenは
「A列のデータの個数が２未満ならGoTo LoopLastする」です。

下記はA２に「No.」、A３にフィルタで絞り込んだ値があるので関数の戻り値は２になります。

ですので、戻り値が１だったら絞り込んだ値が無いという判定ができます。
設定値とユーザ名も同様の流れになります。

ここまでいかがだったでしょうか。
環境シートでフィルタを実行して、絞れなかったらループを実行するというマクロの説明でした。
ここからは、無事全て絞り込むことができた場合の続きの処理の説明をしていきます。

【セルの色付け】
ser（追加対象シートのサーバ名）がインターネットサーバなら該当セルを色付けします。

If tk.Cells(i, 5) = "インターネットサーバ" Then
Range("A1").Resize(Range("A1"). _
   CurrentRegion.Rows.Count - 2).Offset(2, 5).Interior.Color = vbYellow
.
.
.
省略
.
.
End If

CurrentRegionを使用することで、フィルタで表示されているセルだけに色を付けられます。
CurrentRegionを使わないと非表示になっている関係ないセルに色がついてしまいますのでご注意を。

ここでは、ResizeとCurrentRegionとOffsetを組み合わせて色付けしていきます。

※Resize汎用の型
Selection.Resize(Selection.Rows.Count + 1).Select '行だけを拡張
Selection.Resize(, Selection.Columns.Count + 1).Select '列だけを拡張

サーバごとに色付けしたいセルは違うのでOffsetの値を変更して該当セルに色付けします。
それをサーバの数だけ繰り返していきます。

色付け処理を終えたら次です。

【追加対象シートに正常に色付けされたことを分かりやすく表示】

tk.Cells(i, 6).Interior.Color = vbYellow
tk.Cells(i, 6).Value = "OK"

これは、マクロ処理が終わったあと確認しやすいためです。
フィルターで絞り込みができなかったときは空白のままになっているので見やすいです。

【GoTo LoopLastのワープ先はここ】

LoopLast:

ワープ後、後続記載の処理へと進んでいきます。

【追加対象シートのF列が「空白」の場合メッセージを表示】
追加対象シートのF列が「空白」の場合「環境シートの確認の必要あり」と表示されるようにします。

If tk.Cells(i, 6).Value = "" Then
    tk.Cells(i, 6).Value = "環境シートの確認の必要あり"
End If

【重複行の判定】
誤って同じものを登録してしまう…そんなこともありうるので重複している行が存在した場合
色をつけて環境シートで確認できるようにします。
Subtotal関数でフィルター後に３行以上あった場合はA列に色付けします。

If WorksheetFunction.Subtotal(3, Range("A:A")) > 2 Then
   Range("A1").Resize(Range("A1"). _
   CurrentRegion.Rows.Count - 2).Offset(2, 0).Interior.Color = vbYellow
End If

マクロ実行後にA列をみて色があったときは、確認して必要ない方を削除するといいです。

そして、最後に

【フィルターの絞り込みをクリア】

hs.ShowAllData

For文Nextの直前にいれます。ここまでで処理は終了です。

さいごに

いかがだったでしょうか。今回は自動チェックツールとしてマクロを作成しましたが、
マクロが正常に動作していることを確認したら色付けではなくて、「●」をつけるようにすれば、
環境シートの自動作成ツールにもなります。
作業現場にて少しでもお役に立てれば幸いです。

以上、チェックツールの自動化についてでした。