解決済み

エクセルVBAで該当するセルに色をつけたい

  • 困ってます
  • 質問No.8284911
  • 閲覧数448
  • ありがとう数2
  • 気になる数0
  • 回答数6
  • コメント数0

お礼率 33% (2/6)

ご覧いただき、ありがとうございます。
当方、VBA初心者です。

エクセルVBAで、「対象の社名」に該当するセルに色をつけたいと思っています。
それぞれ別シートになります。

たとえば、abc(株)が対象なら、

1.(株)は(株)や株式会社など表記がバラバラなので取る⇒abcの文字列が検索対象
2.「検索シート」にあるabcを検索
3.対象のセルに色をつける
4.文字列がある限り(この場合は○がついている部分はずっと)検索続ける
※○の数式はつけた方が探しやすいと思って作ったので、なくても構いません

わかりづらい文章ですみません。
ぜひお知恵を貸してください><

質問者が選んだベストアンサー

  • 回答No.6

ベストアンサー率 41% (562/1346)

また追加です 追加ばかりで申し訳ありません

検索範囲がB2から始まってるとしたらこちらも変更してください。

MyBottom = Worksheets("検索シート").Range("A" & Rows.Count).End(xlUp).Row

MyBottom = Worksheets("検索シート").Range("B" & Rows.Count).End(xlUp).Row

その他の回答 (全5件)

  • 回答No.5

ベストアンサー率 41% (562/1346)

追加その3です

なんかよーく見ると検索範囲がB2から始まってるみたいなので

With Worksheets("検索シート").Range("A1:A" & MyBottom)

With Worksheets("検索シート").Range("B2:B" & MyBottom)

に変更してください。
お礼コメント
oshiete0224

お礼率 33% (2/6)

こちらで作成したわかりづらい図にも関わらず、
細かい回答ありがとうございました!
現在コーディングしてますので、
もしかしたらまた質問させていただくかもしれません。。
取り急ぎ、お礼申し上げます。
投稿日時 - 2013-09-30 15:41:11
  • 回答No.4

ベストアンサー率 41% (562/1346)

追加その2です

なんか左側の画像のシートが社名一覧みたいになっているみたいですが、もしかしてそれをすべて検索したいというのでしたら

シート名が分からないのでSheet2としました

For i = 2 To Worksheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row
'Myfindstr = Range("C1").Valueの部分が
'↓
Myfindstr = Worksheets("Sheet2").Range("B" & i).Value

先に示したコード

Next i

としてください。
  • 回答No.3

ベストアンサー率 41% (562/1346)

追加です

検索したい社名がどこかのセルにあるとしたら(たとえばC1とか)

Myfindstr = Range("C1").Value

として

Set c = .Find("*abc*", LookIn:=xlValues)



Set c = .Find("*" & Myfindstr & "*", LookIn:=xlValues)

に変更してください。
  • 回答No.2

ベストアンサー率 41% (562/1346)

画像が見難いのでどこに何があるのか分かりませんが

以下のコードはA列に社名があるとして abc を含む社名のセルを見つけてグレーに塗ります。

Dim MyBottom As Long
Dim c As Range
Dim firstAddress As String

MyBottom = Worksheets("検索シート").Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("検索シート").Range("A1:A" & MyBottom)
Set c = .Find("*abc*", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
With c.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With


なお .ColorIndex の色は以下のページを参照にして好きなものを選んでください。

http://www.relief.jp/itnote/archives/000482.php
  • 回答No.1

ベストアンサー率 49% (2537/5117)

こんばんは!
画像が小さくて詳細が判りません。

質問文だけで判断し、「sbc」が含まれているセルを「黄色」に塗りつぶすようにしてみました。

↓のコードを標準モジュールにコピー&ペーストしてマクロを実行してみてください。

Sub Sample1()
Dim c As Range
For Each c In ActiveSheet.UsedRange
If InStr(c, "abc") > 0 Then
c.Interior.ColorIndex = 6
End If
Next c
End Sub

※ 画像ではA列に会社名?があるように見えるのですが、
すべてのセルを対象にしています。m(_ _)m
お礼コメント
oshiete0224

お礼率 33% (2/6)

回答ありがとうございます!!
画像が小さくてすみませんでした…
投稿日時 - 2013-09-30 11:06:14
AIエージェント「あい」

こんにちは。AIエージェントの「あい」です。
あなたの悩みに、OKWAVE 3,500万件のQ&Aを分析して最適な回答をご提案します。

関連するQ&A
このやり方知ってる!同じこと困ったことある。経験を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する

特集

ピックアップ

ページ先頭へ