プチIT化 PR

【VBA】条件によってセルを網掛け・解除・カウントするマクロサンプル

記事内に商品プロモーションを含む場合があります。
当サイトは、アフィリエイト広告を利用しています。

こんにちは、わたあめです。今日はExcel VBAマクロで網掛け設定を行うサンプルを記事といくつか作成してみた記事なります。今回、紹介するマクロサンプルは、以下です。

  • 基本の網掛け
  • 条件によって網掛け
  • 網掛けがあったら解除
  • 網掛けされているセルをカウントする
  • 網掛けされていないセルの行を削除

これらを紹介していきたいと思います!使えそうなマクロサンプルがあれば幸いです。

基本の網掛けマクロサンプル

網掛けの基本の使い方です。網掛けを行うサンプルマクロは以下の通りです。網掛けの種類は縞や格子などありますが、今回はシンプルな「灰色」パターンを使っていきます。

'A1に網掛け網掛けしたいセルの選択
Range("A1").Interior.Pattern = xlGray25

A1に網掛けを行っています。サンプルのパターンは「25%灰色」としていますが、"xlGray25"の値を変えることによって、網掛けの濃淡を調整できます。以下の通りです。

条件によって網掛けするマクロサンプル

条件に一致したら網掛けを行うという処理を行うマクロサンプルです。A1~A10に1~10の数字が入っている状況で、セルの値が5より大きい場合に網掛けするという処理を行っているサンプルです。

' 条件に一致したら網掛する

'1行目から10行目までを処理
For i = 0 To 10
  If Range("A" & i + 1).Value >= 5 Then
    Range("A" & i + 1).Interior.Pattern = xlGray25
  End If
Next

iの値は1,2,3,4....10とカウントアップしています。iを使ってA1~A10に対して処理をしています。If文で5より大きかったら網掛けするという内容です。

とある文字列を含む場合にアレンジするには

文字列を含む場合、IF分の箇所を以下のようにInStr関数で判定すると良いです。

If InStr(Range("A" & i + 1).Value, "さくら") Then

「さくら」という文字列があれば網掛けするような処理となっています。

網掛けがあったら解除するマクロサンプル

セルに網掛けがあった場合、解除するというマクロサンプルです。

' 網掛けがあるか判定して解除する

'A1からA10までを処理
For i = 0 To 10
If Range("A" & i + 1).Interior.Pattern <> xlPatternNone Then
Range("A" & i + 1).Interior.Pattern = xlPatternNone
End If
Next

iの値は1,2,3,4....10とカウントアップし、A1~A10に対して処理をしています。処理内容は、If文でセルが網掛けされていたらパターンを無しにする(xlPatternNone)設定を入れています。※塗りつぶしの色がついている場合も、解除されます。

網掛けのセルカウントを行うマクロサンプル

網掛けセルがあった場合、カウントするという処理です。最後にカウント数をメッセージボックスで出力しています。

' 網掛けがあるか判定してカウントする

'A1からA10までを処理
Dim cCount As Integer

cCount = 0
For i = 0 To 10
  If Range("A" & i + 1).Interior.Pattern <> xlPatternNone Then
    cCount = cCount + 1
  End If
Next

MsgBox ("網掛けセルの個数:" & cCount)

Interior.Patternが無し(xlPatternNone)じゃなかったら、カウントアップするという処理内容です。

網掛けがない行を削除マクロサンプル

網掛けされていない行を削除するマクロサンプルです。A列で(連続しているセル)最終行を取得して、網掛されているセルはそのまま、網掛されていないセルの行は削除するというマクロとなります。

' 網掛けされていないセルの行は削除する

'A1からA10までを処理
Dim rCount, maxRow As Integer

' 最終行取得
maxRow = Range("A1").End(xlDown).Row

rCount = 1
For i = 0 To maxRow
  If Range("A" & rCount).Interior.Pattern = xlPatternNone Then
    Rows(rCount).Delete
  Else
    rCount = rCount + 1
  End If
Next

さいごに

いかがだったでしょうか。ワークシートの指定など、実行するExcelによってうまくいかないこともあるかと思いますが、少しでもロジックが参考になればと思い、また自分の備忘メモとしてまとめてみました。

それでは、また!