作者別: it-yobi

以下のシートのセルA2に入力されているステータスに応じて、シート見出しの色を自動で変更する仕組みについて解説していきます。

こちらの内容は、VBAで開発しています。
※実際に開発したファイルに関しては、記事の最後にて配布しています。

1. 開発準備

今回の機能は、各シートのセルA2のステータスの値に応じて、シート見出しの色が変換するという内容です。
セルA2にステータスが入力されているシートに関して、全てに適用する場合は、ブックモジュールを活用します。

ブックモジュールは、[開発]タブの中の[Visual Basic]を選択して、プロジェクトウィンドウから[ThisWorkbook]を選択することで、表示することができます。

表示されたブックモジュールにて、上のリストから[Workbook]を選択し、隣のリストから[SheetChange]を選択します。

表示された[Workbook_SheetChange]というプロシージャのみを活用します。
他のプロシージャに関しては、削除しても問題ございません。

[Workbook_SheetChange]というプロシージャが、各シートのセルが編集された時に実行されるイベントプロシージャになります。
このプロシージャの引数「Sh」に実行のきっかけとなったシートの情報、引数「Target」に実行のきっかけとなったセルの情報が渡されます。

2. コードの記述

これらの情報を活用して、以下のように処理を記述します。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
    If Sh.Range("A1").Value = "ステータス" Then
        If Sh.Range("A2").Value = "確認待ち" Then
            Sh.Tab.Color = RGB(255, 255, 0)
        ElseIf Sh.Range("A2").Value = "修正待ち" Then
            Sh.Tab.Color = RGB(255, 165, 0)
        ElseIf Sh.Range("A2").Value = "完了" Then
            Sh.Tab.Color = RGB(180, 180, 180)
        Else
            Sh.Tab.ColorIndex = xlColorIndexNone
        End If
    End If
    
End Sub

では、このコードの処理の内容を解説します。

If Sh.Range("A1").Value = "ステータス" Then

初めに、対象のシートのセルA1に”ステータス”という文字が入力されているかどうかを確認します。
”ステータス”という文字が入力されている場合に関してのみ、内側の以下の処理を実行します。

If Sh.Range("A2").Value = "確認待ち" Then
    Sh.Tab.Color = RGB(255, 255, 0)
ElseIf Sh.Range("A2").Value = "修正待ち" Then
    Sh.Tab.Color = RGB(255, 165, 0)
ElseIf Sh.Range("A2").Value = "完了" Then
    Sh.Tab.Color = RGB(180, 180, 180)
Else
    Sh.Tab.ColorIndex = xlColorIndexNone
End If

ここで、セルA2の値が”確認待ち”なのか、”修正待ち”なのか、”完了”なのか、それ以外なのかを判断し、それぞれの条件に合ったシート見出しの色を設定しています。

Sh.Tab.Color = RGB(255, 255, 0)

”確認待ち”の場合は、上記の内容でシート見出しの色を黄色にしています。
色はRGBで指定しています。
他、”修正待ち”の場合はオレンジ色、”完了”の場合は灰色にしています。

Sh.Tab.ColorIndex = xlColorIndexNone

どれにも該当するステータスがない場合は、上記の内容でシート見出しの色をリセット（色なし）しています。
リセットする場合は、ColorIndexを使用し、xlColorIndexNoneと指定します。

3. 完成

このコードを記述することで、以下のように、セルA2のステータスに応じて、該当するシート見出しの色が自動で変更されます。

▼サンプルファイル▼

この記事では、特定のデータを選択して「抽出」ボタンを押すだけで、関連データを別シートに自動で抽出する機能の開発方法について解説しています。
解説には、以下の表を活用します。

（例）「男」を選択して「抽出」ボタンを押す → 「男」シートが作成され「男」のデータのみが抽出される

※開発したファイルは、記事の最後で配布しています。

1. 開発準備

まずは、[開発]タブの中の[マクロ]を選択します。

表示された以下の画面にて、開発する機能の名前を入力します。
こちらでは「抽出」と入力しています。

入力後、[作成]ボタンを押します。

以下の画面が表示されましたら、エディタ内のSub～End Subの中にプログラムを記述していきます。
※Option Explicitはエディタの設定内容によっては表示されません。

2. コードの記述

Sub～End Subの中に記述する内容は、以下になります。

Sub 抽出()
    
    Dim t As Range
    Set t = ActiveCell
    
    t.AutoFilter Field:=t.Column - 1, Criteria1:=t.Value
    Columns("A:E").Copy
    
    With Worksheets.Add
        .Range("A1").PasteSpecial Paste:=xlPasteFormats
        .Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
        .Range("A1").PasteSpecial Paste:=xlPasteValues
        .Name = t.Value
        .Range("A1").Select
    End With
    
    t.AutoFilter
    
End Sub

先頭から順番に解説していきます。

Dim t As Range
Set t = ActiveCell

こちらでは、tというセルの情報を格納する用の変数（入れ物）を用意し、アクティブセル（選択基準のセル）の情報を格納しています。

t.AutoFilter Field:=t.Column - 1, Criteria1:=t.Value

こちらで、先ほど定義したtのセルを基準にフィルター機能で絞り込みを行っています。
絞り込みの内容は、tの列番号から１を引いた位置の列（表がB列から始まっているため、実際の項目の位置情報と列番号は異なる）に対し、tのセルの値と一致するデータになります。

以下の場合、セルD5が選択されているため、D列の列番号の４から１を引いた３番目の項目（性別）に、セルD5の値（男）が入力されているデータのみで絞り込みを行います。

Columns("A:E").Copy

そして、絞り込みをした表を含むA～E列の範囲をコピーしています。

With Worksheets.Add
    .Range("A1").PasteSpecial Paste:=xlPasteFormats
    .Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
    .Range("A1").PasteSpecial Paste:=xlPasteValues
    .Name = t.Value
    .Range("A1").Select
End With

こちらで、新しいシートを追加し、コピーしたデータ（書式、列幅、値）を貼り付けています。
貼り付けた後に、シート名をtのセルの値にし、そのシートのセルA1を選択するという処理です。

t.AutoFilter

最後に、絞り込みをした表の絞り込みを解除して、処理が終了します。

3. ボタンの作成

後は、開発した機能をボタンに割り当てます。
ボタンは、[開発]タブの中の[挿入]から[ボタン]を選択することで作成することができます。

図形の作成時と同様に、好みの位置にボタンを作成することができます。
ボタンを作成すると[マクロの登録]という画面が表示されるため、開発したマクロ（こちらの場合は「抽出」）を選択して確定します。

必要に応じて、ボタンの表示名を変更することで、ボタンの完成です。
※一度作成したボタンを選択すると、割り当てた処理が実行されてしまいます。
作成したボタンを編集する際は、右クリック、もしくは、Ctrlキーを押しながら選択します。

4. 完成

以上の手順で完成です。

好みのデータを選択してから「抽出」ボタンを押すことで、選択したデータに関連するデータを別シートに抽出することができます。

こちらで開発したExcelファイルは、以下になります。

▼サンプルファイル▼