Excel VBA 指定した表を自動的に背景色をゼブラ模様（縞模様）にする。効率的な事務処理テクニック！
Excel VBA 指定した表を自動的に背景色をゼブラ模様（縞模様）にする。効率的な事務処理テクニック！
今回説明するのは、指定した表に対して自動的に背景色（ゼブラ模様）にする方法を説明いたします。今回のプログラムでは、効率的な事務処理テクニックとして、指定した表範囲に対して自動的にゼブラ模様を適用するサンプルプログラムとその実行方法を解説しています。表をゼブラ模様に切り替えることで、表の可読性が向上し、データが見やすくなります。それでは、順番に説明いたします。
●【Interior.Color プロパティ (Excel)、下記を参照して下さい】（Microsoft社 様）】
https://learn.microsoft.com/ja-jp/office/vba/api/excel.interior.color
Excel VBAゼブラストライプの自動適用方法：アクティブシートから表範囲を自動取得
下記のサンプルプログラムは、Excelのワークシート内の表にゼブラ模様を適用するためのVBAコードです。ゼブラ模様は、表の行の背景色を交互に設定することによって、表の可読性を向上させるための一般的なデザインになります。背景色を指定していないシンプルな表よりも、ゼブラ模様（縞模様）にした方が見やすくなりますので、是非とも利用してください。
【プログラムの流れ】
【このコードの処理内容】
このコードは、アクティブシート内の指定された範囲にゼブラ模様を適用します。交互に色分けされた行を生成することで、表の可読性が向上します。
【処理手順】
① アクティブシートを取得
② 開始セルを設定
③ 表の終了行と終了列を取得
④ 表の範囲を設定
⑤ ゼブラ模様の背景色を設定
【プログラム実行条件・注意事項】
① ゼブラ模様は、開始セル（C3）から始まります。異なる範囲でゼブラ模様を適用したい場合は、開始セルを変更してください。
② 色の設定はRGBで指定されています。異なる色を使用したい場合は、RGBの値を変更してください。
【下記のプログラムを業務で利用する場合】
① 社員一覧表や顧客リストなど、行ごとにデータが格納されている表に適用して可読性を向上させる。
② 売上報告書や在庫管理表に適用し、データの把握を容易にする。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 |
’ ’ Option Explicit Sub ZebraPattern() '表に対して背景色を縦のゼブラ模様にする。 Dim wsResult As Worksheet Dim resultRange As Range Dim cell As Range Dim lastRow As Long Dim lastCol As Long Dim startCell As Range Dim lastColLetter As String ' アクティブシートをゼブラ模様の対象に設定 Set wsResult = ActiveSheet ' 開始セルを設定 Set startCell = wsResult.Range("C3") ' 表の終了行を取得 lastRow = wsResult.Cells(wsResult.Rows.Count, startCell.Column).End(xlUp).Row ' 表の終了列を取得 lastCol = wsResult.Cells(startCell.Row, wsResult.Columns.Count).End(xlToLeft).Column lastColLetter = Split(Cells(1, lastCol).Address, "$")(1) ' 表の範囲を設定 Set resultRange = wsResult.Range(startCell.Address & ":" & lastColLetter & lastRow) ' ゼブラ模様の背景色を設定 For Each cell In resultRange If cell.Row Mod 2 = 0 Then cell.Interior.Color = RGB(204, 229, 255) ' 偶数行の背景色 Else cell.Interior.Color = RGB(153, 204, 255) ' 奇数行の背景色 End If Next cell End Sub ’ ’ |
（画面クリックして拡大）
Excel VBAゼブラストライプの自動適用方法：アクティブセルから表範囲を自動取得（列に対してゼブラ模様）
★下記のサンプルプログラムは、サンプルプログラム①と同じくExcelのワークシート内の表にゼブラ模様を適用するためのプログラムです。指定したアクティブセルを起点に、表の範囲を特定し、その範囲内のセルに偶数列と奇数列で異なる背景色を適用することで、列単位のゼブラ模様を作成します。なお、指定したアクティブセルが左上の起点としてゼブラ模様を適用する事になります。
【プログラムの流れ】
① アクティブシートを取得し、wsResult変数に設定します。
② アクティブセルを開始セルとして設定します。（起点を表の左上にする）
③ 表の終了行と終了列を取得します。
④ 取得した終了行と終了列をもとに、表の範囲を特定し、resultRange変数に設定します。
⑤ resultRange内の各セルに対して、列が偶数か奇数かに応じて異なる背景色を適用します。
【プログラム実行条件・注意事項】
① このコードはアクティブセルを起点に動作するため、実行前にアクティブセルを適切な位置に設定してください。
② セル範囲が大きい場合、処理に時間がかかる可能性があります。
③ 既に背景色が設定されているセルがある場合、実行すると上書きされます。
★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。
● Zebra02（サンプルプログラム）
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 |
' ' Sub ZebraPattern() 'ゼブラ模様（列） Dim wsResult As Worksheet Dim resultRange As Range Dim cell As Range Dim lastRow As Long Dim lastCol As Long Dim startCell As Range Dim lastColLetter As String ' アクティブシートをゼブラ模様の対象に設定 Set wsResult = ActiveSheet ' 開始セルをアクティブセルに設定 Set startCell = ActiveCell ' 表の終了行を取得 lastRow = wsResult.Cells(wsResult.Rows.Count, startCell.Column).End(xlUp).Row ' 表の終了列を取得 lastCol = wsResult.Cells(startCell.Row, wsResult.Columns.Count).End(xlToLeft).Column lastColLetter = Split(Cells(1, lastCol).Address, "$")(1) ' 表の範囲を設定 Set resultRange = wsResult.Range(startCell.Address & ":" & lastColLetter & lastRow) ' ゼブラ模様の背景色を設定（列に適用） For Each cell In resultRange If cell.Column Mod 2 = 0 Then cell.Interior.Color = RGB(204, 229, 255) ' 偶数列の背景色 Else cell.Interior.Color = RGB(153, 204, 255) ' 奇数列の背景色 End If Next cell End Sub ' ' Sub ZebraPattern_Clear() 'アクティブシートの背景色をクリア Dim wsResult As Worksheet ' アクティブシートを設定 Set wsResult = ActiveSheet ' アクティブシートの背景色を削除 wsResult.Cells.Interior.Color = xlNone End Sub |
（画面クリックして拡大）
Excel VBAゼブラストライプの自動適用方法：Functionプロシージャ化して繰り返し利用可能、模様の色変更
下記のサンプルプログラムは、①と②の応用となります。ゼブラ模様（縞模様）のコードをFunctionプロシージャ化して何度も利用できるように作り変えました。今回のプログラムでは、指定されたワークシートの範囲に、縞模様（ゼブラ模様）の背景色を適用するものです。セルの背景色は、種類化されており、指定されたsetColorによって異なる縞模様の色を選択することができます。
【プログラムの流れ】
●全体的な流れ
① ZebraPattern関数を定義し、ワークシート、開始セル、および色設定をパラメータとして受け取ります。
② 終了行と終了列を取得し、セル範囲を設定します。
③ セル範囲内の各セルの背景色を、setColorに基づいて縞模様に設定します。
★１ ApplyZebraPattern01、ApplyZebraPattern02、およびApplyZebraPattern03の各サブプロシージャを定義し、ZebraPattern関数をそれぞれ異なる色設定で呼び出します。
★２ ZebraPattern_Clearサブプロシージャを定義し、アクティブシートのセルの背景色をクリアします。
①～③Function ZebraPattern(wsTarget As Worksheet, startCell As Range, setColor) As Rangeの実行手順:
１．指定されたワークシート(wsTarget)と開始セル(startCell)を使用して、表の終了行と終了列を取得します。
２．終了行と終了列を使用して、処理対象の範囲(resultRange)を設定します。
３．処理対象の範囲に対して、セルを1つずつ処理します。
４．セルの行が偶数か奇数かに応じて、setColorパラメータで指定された縞模様の背景色を適用します。
５．処理が完了した範囲(resultRange)をFunctionの戻り値として返します。
★１：Sub ApplyZebraPattern01～03()の実行手順:
１．対象のワークシート(wsResult)、開始セル(startCell)、縞模様の色(setColor)を指定します。
２．ZebraPattern関数に対象のワークシート、開始セル、縞模様の色を渡し、縞模様を適用します。
★２：Sub ZebraPattern_Clear()の実行手順:
１．アクティブシート(wsResult)を設定します。
２．アクティブシートの全てのセルの背景色をクリアします。
【プログラム実行条件・注意事項】
① 存在するワークシート、開始セル、および色設定を指定することが重要です。
② セル範囲が広い場合、実行に時間がかかる場合があります。
★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。
● Zebra03（サンプルプログラム）
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 |
' ' Option Explicit Function ZebraPattern(wsTarget As Worksheet, startCell As Range, setColor) As Range Dim resultRange As Range Dim cell As Range Dim lastRow As Long Dim lastCol As Long Dim lastColLetter As String ' 表の終了行を取得 lastRow = wsTarget.Cells(wsTarget.Rows.Count, startCell.Column).End(xlUp).Row ' 表の終了列を取得 lastCol = wsTarget.Cells(startCell.Row, wsTarget.Columns.Count).End(xlToLeft).Column lastColLetter = Split(Cells(1, lastCol).Address, "$")(1) ' 表の範囲を設定 Set resultRange = wsTarget.Range(startCell.Address & ":" & lastColLetter & lastRow) ' ゼブラ模様の背景色を設定 For Each cell In resultRange If cell.Row Mod 2 = 0 Then Select Case setColor Case 1 cell.Interior.Color = RGB(255, 153, 153) ' 偶数行の背景色 Case 2 cell.Interior.Color = RGB(153, 255, 153) ' 偶数行の背景色 Case 3 cell.Interior.Color = RGB(204, 153, 255) ' 偶数行の背景色 Case Else cell.Interior.Color = RGB(153, 255, 153) ' 偶数行の背景色 End Select Else Select Case setColor Case 1 cell.Interior.Color = RGB(255, 102, 102) ' 奇数行の背景色 Case 2 cell.Interior.Color = RGB(102, 255, 102) ' 奇数行の背景色 Case 3 cell.Interior.Color = RGB(178, 102, 255) ' 奇数行の背景色 Case Else cell.Interior.Color = RGB(102, 255, 102) ' 奇数行の背景色 End Select End If Next cell Set ZebraPattern = resultRange End Function Sub ApplyZebraPattern01() Dim wsResult As Worksheet Dim startCell As Range Dim setColor As Integer ' ゼブラ模様の対象のワークシート名と起点となる開始セル縞模様の色を指定 Set wsResult = ThisWorkbook.Worksheets("Sheet1") Set startCell = wsResult.Range("C3") setColor = 1 ' FunctionプロシージャZebraPatternに問い合わせ Call ZebraPattern(wsResult, startCell, setColor) End Sub Sub ApplyZebraPattern02() Dim wsResult As Worksheet Dim startCell As Range Dim setColor As Integer ' ゼブラ模様の対象のワークシート名と起点となる開始セル縞模様の色を指定 Set wsResult = ThisWorkbook.Worksheets("Sheet1") Set startCell = wsResult.Range("C3") setColor = 2 ' FunctionプロシージャZebraPatternに問い合わせ Call ZebraPattern(wsResult, startCell, setColor) End Sub Sub ApplyZebraPattern03() Dim wsResult As Worksheet Dim startCell As Range Dim setColor As Integer ' ゼブラ模様の対象のワークシート名と起点となる開始セル縞模様の色を指定 Set wsResult = ThisWorkbook.Worksheets("Sheet1") Set startCell = wsResult.Range("C3") setColor = 3 ' FunctionプロシージャZebraPatternに問い合わせ Call ZebraPattern(wsResult, startCell, setColor) End Sub ' ' Sub ZebraPattern_Clear() 'アクティブシートの背景色をクリア Dim wsResult As Worksheet ' アクティブシートを設定 Set wsResult = ActiveSheet ' アクティブシートの背景色を削除 wsResult.Cells.Interior.Color = xlNone End Sub ' ' |
奇数行の背景色: RGB(255, 102, 102) 赤系縞模様
同様に、ApplyZebraPattern02とApplyZebraPattern03を実行すると、それぞれ異なる縞模様の背景色が適用されます。また、ZebraPattern_Clearサブプロシージャを実行すると、アクティブシートのセルの背景色がクリアされます。（画面クリックして拡大）
また、VBAに関するテクニックや便利な手法などをこのサイトに掲載していきますので、定期的に参照していただけると幸いです。