|
▼さとちぃ さん:
>ZF株式会社は複数ある場合がありますので、複数箇所色を変える表示が望ましいです。
そのばあいは さとちぃさんがやっておられるような Findメソッドの繰り返しと
なります。
(↓こんな感じ: 下のほうを修正)
Sub 別シートの会社名セルに色を付ける2() '列を特定しない
Dim c As Range
Dim Sheetname As String
Dim CompanyName As String
'ActiveSheetは 「会社情報一覧」
If ActiveCell.Column <> 1 Then Exit Sub
'ActiveCellが A列のときだけ実行する
CompanyName = ActiveCell.Value
Set c = Cells(ActiveCell.Row, Columns.Count).End(xlToLeft)
If c.Value <> "○" Then Exit Sub
Sheetname = Cells(1, c.Column).Value
'対象シートのA列にフィルタをかける
Dim r As Range
Set r = Worksheets(Sheetname).UsedRange
r.Interior.ColorIndex = xlNone
Set c = r.Find(CompanyName, , xlValues, xlPart)
If c Is Nothing Then Exit Sub
Dim Address1 As String
Address1 = c.Address
Do
'ヒットした行があれば 色を付ける
c.Interior.Color = vbCyan
Set c = r.FindNext(After:=c)
Loop Until c.Address = Address1
End Sub
|
|