MENU

【質問】表の中で、指定文字がある行全体に、色を付けたい。

VBA初心者でも、すぐエクセルの自動化ができます。

質問

表の中で、特定の文字(今回は”赤点”)がある行全体に、色を付けたい。

f:id:The-Alchemist:20220113232150p:plain



手順(作業列を使う)

①作業列にCountIf関数をいれ、行の”特定の文字”の数を数えます

f:id:The-Alchemist:20220113184900p:plain

 

 

 

 

 

左は、関数入力の設定画面です。

・作業列は、表の外側のH列に作ります。しかし、H列の最終行は無限なので、表の右端F列で最終行を求め、F列から右に2つオフセットして、H列に関数を入力します。

 

 

 

・入力する関数は、=COUNTIF(B2:F2,"赤点")です。関数は=を含め”で囲み、文字列はふたつの”で囲むので、"=COUNTIF(B2:F2,""赤点"")"とします。

 

F列から右に2つオフセットして、H列に関数を入力します。

 

 

②H列のCountIf関数の結果が0以外のとき、B列からF列まで、OffsetResizeを使い行に色を付けます

f:id:The-Alchemist:20220113185133p:plain

 

 

 

 

左は、セルに色を付ける設定画面です。

 

 

作業列のH列のCountIF関数の結果をもとに、色付けします。

 

 

 

 

H列のCountIF関数の結果が、0以外のとき、色を付けます。

 

 

色を付ける場所は、関数のあるH列ではなく、H列から左に6列OffsetしたB列から、右に5列ResizeしたF列までの範囲に色付けします。

 

 

色は、74番の黄色です。

 

 

 

 

 

 

 

 

 

 

 

 

③作業列を削除します

f:id:The-Alchemist:20220113185957p:plain

 

左は、H列を削除する設定画面です。

 

 

 

 

 

 

 

 

 

 

 

 

 

表示されるコード

①関数の入力

Sub デモ_1() '入力
Dim セル範囲 As String, セル As Range, 右下セル As String
Sheets("sheet1").Select
'◆最終行を取得し、セル範囲を決める
Range("f2:f2").CurrentRegion.Select
右下セル = Cells(Selection.Row + Selection.Rows.Count - 1, Range("f2").Column).Address(False, False)
セル範囲 = "f2" & ":" & 右下セル
Range(セル範囲).Select
Call デモ_1_メイン処理(セル範囲)
End Sub

Sub デモ_1_メイン処理(セル範囲 As String)
Selection.Offset(0, 2).Formula = "=COUNTIF(B2:F2,""赤点"")"
End Sub

②色の変更

Sub デモ_2() '色変更
Dim セル範囲 As String, セル As Range, 右下セル As String
Sheets("sheet1").Select
'◆最終行を取得し、セル範囲を決める
Range("h2:h2").CurrentRegion.Select
右下セル = Cells(Selection.Row + Selection.Rows.Count - 1, Range("h2").Column).Address(False, False)
セル範囲 = "h2" & ":" & 右下セル
'◆条件分岐
For Each セル In Range(セル範囲).Cells
 If セル.Value <> 0 Then
   セル.Select
   Call デモ_2_メイン処理(セル範囲)
  End If
Next
End Sub

Sub デモ_2_メイン処理(セル範囲 As String)
Selection.Offset(0, -6).Resize(, 5).Interior.Color = RGB(255, 255, 0)
End Sub

③作業列の削除

Sub デモ_3() '行・列の挿入・削除
Dim セル範囲 As String, セル As Range, 右下セル As String
Sheets("sheet1").Select
セル範囲 = "h2:h2"
Range(セル範囲).Select
Call デモ_3_メイン処理(セル範囲)
End Sub
 
Sub デモ_3_メイン処理(セル範囲 As String)
Selection.EntireColumn.Delete
End Sub   

④連続トリガー

Sub デモ_連続トリガー() 
        Call デモ_1()
        Call デモ_2()
        Call デモ_3() 
End Sub

これらのコードをVBE画面に貼り付けて、デモ_連続トリガーで実行します。

アプリはこちらから↓↓↓↓