エクセル VBA 複数シート検索

質問

超初心者です。
エクセルは2000を使用しております。

VBAを使って、複数シート（各フロア）にある座席表から、複数の人名（重複なし）を検索後、該当セルの背景に色を塗って印刷したいのですが、WEBで検索しても思うようにマクロを組めません。お助け願います。

質問が上手く出来ていないかもしれませんが、流れとしては
下記の感じです。

1.あらかじめ決められたシートに検索する人名のリストが存在
2.決められた複数のシートから検索
3.リストを上から順に人名がなくなるまで検索をループ
3.該当のセルの背景を塗りつぶす
4.印刷

簡単に言えば、誰がどのフロアのどこにいるかすばやく検索したいです。

っという感じでしょうか。

回答No.4

keirika

検索エラーを回避するＩＦを追加してみました。

Sub Sample()

Dim Zaseki As Variant
Dim Kensaku As Range
Dim i As Integer
Dim List As Range

Set List = Sheets("Sheet1").Range("a1:a3")

For Each Kensaku In List

Set Zaseki = Sheets(Array("Sheet2", "Sheet3", "Sheet4"))

For i = 1 To Zaseki.Count
Zaseki(i).Select
If Not Cells.Find(Kensaku.Value) Is Nothing Then
Cells.Find(Kensaku.Value).Interior.Color = vbYellow
End If
Next i

Next

Set Zaseki = Nothing
Set List = Nothing

End Sub

お礼

ついに、できました。本当にありがとうございます。
ただまだ、理解ができない部分があるので
これからも精進してまいります。

keirikaさん
本当にありがとうございます。

回答No.3

keirika

エラーの箇所は文字列を検索するところです。

検索対象の文字列がシートに存在しないか、Listの指定に何か問題が
あるのかも知れません。

例としてあげたものは、動作確認をしましたので、実際のコードを
提示していただければ、何かわかるかも知れません。

お礼

お礼が遅れまして、申し訳ないです。
ありがとうございます。

しかし、教えて頂いたコードで動作確認をしましたが、
やはりリストの一番上のみ実行され次以降が検索出来ていなく
また、塗りつぶしもできていない状況です。

他の方は、このコードで動作確認できているのでしょうか？
もしくは私の方法に間違いがあるのかさっぱりわかりません。

自分は、動作確認で、
シート１のA1：A3に名前を入力し、
シート２のA1にリスト一番上の名前を入力
シート３のA1にリスト二番目の名前を入力
シート４のA1にリスト三番目の名前を入力

標準モジュール挿入し、教えて頂いたコードをそのままコピー

VBA実行としています。
するとリスト一番上の名前のみ実行されていてその次移行はエラー
になります。

これに間違いがありますか？

回答No.2

keirika

こんな感じでどうでしょう。

Sheet1のA1からA3までの名前を検索します。
必要に応じて範囲は増やしてください。
なお、エラー処理は含めていませんので、前回と同様
シートに検索対象の名前が存在しない場合はエラーになります。

変更点としては
・Kensakuの型をStringからRange
・Listを追加し、検索文字のセル範囲をセット
・For Eachでセル範囲の数だけループ

以上です。

Sub Sample()

Dim Zaseki As Variant
Dim Kensaku As Range
Dim i As Integer
Dim List As Range

Set List = Sheets("Sheet1").Range("a1:a3")

For Each Kensaku In List

Set Zaseki = Sheets(Array("Sheet2", "Sheet3", "Sheet4"))

For i = 1 To Zaseki.Count
Zaseki(i).Select
Cells.Find(Kensaku.Value).Interior.Color = vbYellow
Next i

Next

Set Zaseki = Nothing
Set List = Nothing

End Sub

お礼

また返事が遅くなりすいません。

結果ですが、1つ目の検索後、背景塗りつぶしは出来ているのですが次のリストからは検索出来ていないようです。

ちなみに下記箇所にてエラーが出ています。
分かりますでしょうか？

Cells.Find(Kensaku.Value).Interior.Color = vbYellow

補足

早速の回答有難う御座います。＾－＾

今日会社でやって見ます。
また結果をお伝えします。

回答No.1

keirika

色を塗る所まで書きます。

検索文字列は「山田」、検索範囲はSheet1～Sheet3でセルの色を
黄色に塗ります。

Sub Sample()

Dim Zaseki As Variant
Dim Kensaku As String
Dim i As Integer

Kensaku = "山田"

Set Zaseki = Sheets(Array("Sheet1", "Sheet2", "Sheet3"))

For i = 1 To Zaseki.Count
Zaseki(i).Select
Cells.Find(Kensaku).Interior.Color = vbYellow
Next i

Set Zaseki = Nothing
End Sub

EXCEL2003使用

お礼

有難う御座います。また返事が遅れまして申し訳ないです。

検索後、背景に色を塗るまでは出来ましたが、検索文字が複数ある場合（別シートにリスト形式）は、どのようなloopになるんでしょうか？

例えばSheet1の（1,1）の文字列をSheet2～Sheet4の中から検索後、色を塗り次はSheet1の（2,1）を検索後、色を塗るという具合なんですが、Kensaku = L00Pの条件式って出来るんでしょうか？

マクロの記録ですればこんな感じです。
これをリストの上からすべて検索できればと思います。

Sub 検索後色塗り()

Range("A1").Select
Selection.Copy
Sheets(Array("3F", "4F", "5F")).Select
Cells.Select
Selection.Find(What:="200", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Sheets("3F").Select
Range("A6").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
Sheets("検索リスト").Select
Range("A2").Select
Selection.Copy
Sheets(Array("3F", "4F", "5F")).Select
Cells.Select
Selection.Find(What:="300", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Sheets("3F").Select
Range("A7").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
Sheets("検索リスト").Select
Range("A8").Select
Selection.Copy
Sheets(Array("3F", "4F", "5F")).Select
Cells.Select
Selection.Find(What:="900", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Sheets("4F").Select
Range("B7").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
End Sub