[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『表の該当する文字を含む4行を塗りつぶしたい』(123456)
Sub 色付け1()
Dim c
Dim r As Range For Each r In Range("E1", Cells(Rows.count, 1).End(xlUp)) If InStr(r.Value, "●●") Then c = 6 Else c = 0 r.Resize(, 4).Interior.ColorIndex = c Next End Sub
Sub 色付け2()
Dim c
Dim r As Range For Each r In Range("A1", Cells(Rows.count, 1).End(xlUp)) If InStr(r.Value, "●●") Then c = 6 Else c = 0 r.Resize(, 4).Interior.ColorIndex = c Next End Sub
現在上記のような2つのマクロを使用し、リストのA列から4行、E列から4行をそれぞれ塗りつぶしています。
●●の部分は何パターンか存在し、毎回マクロを開いて打ち換えているのですが、できれば別シートのリストの範囲を参照し、そのリストに含まれるものを色付けするように改良したいです。
また、現在マクロが2つに含まれていますが、できれば1つにまとめてリストの該当する文字が含まれる行から4つ(文字がある行はA列とE列のみのため)塗り潰す式にしたいと考えています。
ご助力の程宜しくお願いします。
< 使用 Excel:Excel2016、使用 OS:Windows7 >
>できれば別シートのリストの範囲を参照し Sheets("Sheet2").Range("N1:N5") にしています。
Sub 色付け3() Dim c As Long, i As Long Dim r As Range For Each r In Range("A1", Cells(Rows.Count, "A").End(xlUp)) For i = 0 To 4 Step 4 If Listsearch(r.Offset(, i)) Then c = 6 Else c = 0 r.Offset(, i).Resize(, 4).Interior.ColorIndex = c Next Next End Sub Function Listsearch(r As Range) As Boolean Dim c As Range For Each c In Sheets("Sheet2").Range("N1:N5") If InStr(r.Value, c) Then Listsearch = True Exit For End If Next End Function
(ピンク) 2020/05/22(金) 13:00
ピンク様 ご回答ありがとうございます。ほぼ試した理想通りの動作をしてくれました。
しかしSheet2のリストなのですが、リスト範囲に空欄が含まれていた場合、リストに該当しない
文字の入力があるセルをすべて塗りつぶしてしまいました。
リストの範囲の空欄を除く場合はどのような式を追加すればよいでしょうか。
ご指導お願いいたします。
(123456) 2020/05/22(金) 14:51
>リストの範囲の空欄を除く場合はどのような式を追加すればよいでしょうか。
If InStr(r.Value, c) Then ↓ If c.Value <> "" And InStr(r.Value, c) Then
(ピンク) 2020/05/22(金) 15:04
訂正
If c.Value <> "" And InStr(r.Value, c) Then ↓ If c.Value <> "" And InStr(r.Value, c.Value) Then
(ピンク) 2020/05/22(金) 15:26
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.