Excelのマクロについてです。プログラミングなんていう大層なカテゴリではないのですが・・・
複数枚あるシート(枚数はランダム)で、左端のSheet1に検索キーワードが入っています。
右側のシート群には上記キーワードがちりばめられており、これらを視覚的に目立たせるマクロを考えています。
つまりSheet1のある範囲(具体的にはE6以下、データが存在する位置までの範囲)に並んだ文字を左のシート群で検索し、引っかかったセルに色をつけたいのですが、下記のマクロでは開始位置(E6)のセルしか見てくれません。
また、検索結果として赤くしたいのはSheet2以降の対象セルなのですが、どうしてもSheet1のセルも赤くなってしまいます。
つまり下記VBAを実行すると、Sheet1.E6の「りんご」の文字を使ってすべてのシートを検索し、Sheet1を含むすべてのシートで「りんご」の文字が入ったセルが赤くなります。
ループを仕込んでいるにもかかわらず「みかん」の文字は赤くなりません。
どこでポカをやっているのでしょうか?

シート関数でしたらそれなりに使えるのですがマクロはなかなか理解しづらく・・・
なにとぞヒントをいただけませんか?

<状況>
最初のシートはE6より縦に
 E6 りんご
 E7 みかん
 ・ 
 ・
 ・
と並び、右のシート(数枚)に、ランダムにその文字が入力されています。書式はバラバラです。
<目標>
最初のシートのある範囲(E6以下)にある文字がSheet2以降で見つかった場合、そのセルを赤く、文字を白くしたい。
以下は自分で作ってみたへぼへぼマクロです:

Sub セルに色付け()

Dim SearchCount As Integer
Dim SearchLineID
Dim WS As Worksheet

Set WS = ActiveSheet  '後で現在のSheetに戻ってくるため

SearchCount = Range("E6").CurrentRegion.Rows.Count  'E6から下に読んでいこうとしています

For i = 1 To SearchCount

SearchLineID = Cells(i + 5, 5).Value  'E6から始めるための補正です

For n = 2 To Sheets.Count  'シートの数を取得し、2枚目から検索を行う意図です

With Application.ReplaceFormat.Font
.Subscript = False
.ColorIndex = 2
End With
Application.ReplaceFormat.Interior.ColorIndex = 3

Sheets(n).Select
Range("A6:AF512").Select    'とりあえずこの範囲を検索
Selection.Replace What:=SearchLineID, Replacement:=SearchLineID, LookAt:= _
xlWhole, SearchOrder:=xlByRows, ReplaceFormat:=True

Next n
Next i
WS.Activate

End Sub

このQ&Aに関連する最新のQ&A

A 回答 (4件)

こんな感じかな?



Sub セルに色付け()
Dim SearchCount As Integer
Dim SearchLineID
Dim WS As Worksheet
Dim c As Range
Dim firstAddress As String
Set WS = ActiveSheet '後で現在のSheetに戻ってくるため
For i = 6 To Worksheets(1).Range("E65536").End(xlUp).Row
SearchLineID = Worksheets(1).Cells(i, 5).Value
For n = 2 To Worksheets.Count 'シートの数を取得し、2枚目から検索を行う意図です
With Worksheets(n).Cells
Set c = .Find(SearchLineID, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = 3
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Next n
Next i
WS.Activate
End Sub

よく分かってないので
うまく処理しなければパスしてね
    • good
    • 0
この回答へのお礼

ありがとうございます。
即効性という点ではこのままマクロを仕込めたので大変助かりました。皆さんに20ptを差し上げられないのが非常に心苦しいです。
マクロをはじめて間もないのですが正解がひとつではなく、それぞれが美しくて大変興味深いです。

お礼日時:2009/05/19 03:59

>ループを仕込んでいるにもかかわらず「みかん」の文字は赤くなりません。


>どこでポカをやっているのでしょうか?
最初の『りんご』のLoop検索で
Sheets(n).Select
とやってますから、最終シートがアクティブになっています。
次に『みかん』を置換しようとして
SearchLineID = Cells(i + 5, 5).Value
とやっても、Cells(i + 5, 5)はアクティブなシートのCellsですから、
最終シートの E7セルのValueをセットしているわけです。

置換のLoopで各シートをSelectせずに置換すれば、
Set WS = ActiveSheet

WS.Activate
も必要ありません。

こんな感じ。
Sub try()
  Dim SearchCount As Integer
  Dim SearchLineID
  Dim i As Long
  Dim n As Long

  SearchCount = Range("E6").CurrentRegion.Rows.Count 'E6から下に読んでいこうとしています
  With Application.ReplaceFormat
    With .Font
      .Subscript = False
      .ColorIndex = 2
    End With
    .Interior.ColorIndex = 3
  End With
  Cells.Find "" '●
  For i = 1 To SearchCount
    SearchLineID = Cells(i + 5, 5).Value      'E6から始めるための補正です
    For n = 2 To Sheets.Count           'シートの数を取得し、2枚目から検索を行う意図です
      Sheets(n).Range("A6:AF512").Replace What:=SearchLineID, _
                        Replacement:=SearchLineID, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        ReplaceFormat:=True
    Next n
  Next i
End Sub

私だったら、こんな風にするかも。
Sub try2()
  Dim SearchLineID
  Dim r As Range
  Dim n As Long
  
  With Application.ReplaceFormat
    With .Font
      .Subscript = False
      .ColorIndex = 2
    End With
    .Interior.ColorIndex = 3
  End With
  Cells.Find "" '●
  With Sheets(1)
    For Each r In .Range("E6", .Range("E6").End(xlDown))
      If r.Value = "" Then Exit For
      For n = 2 To Sheets.Count
        Sheets(n).Range("A6:AF512").Replace What:=r.Value, _
                          Replacement:=r.Value, _
                          LookAt:=xlWhole, _
                          SearchOrder:=xlByRows, _
                          ReplaceFormat:=True
      Next n
    Next
  End With
End Sub

いずれにしても、
>また、検索結果として赤くしたいのはSheet2以降の対象セルなのですが、
>どうしてもSheet1のセルも赤くなってしまいます。
この対策が必要です。

推測ですが、検索置換オプションの[検索場所]が[ブック]になっていませんか?
http://oshiete1.goo.ne.jp/qa4952579.html
その場合
Sheets(n).Range("A6:AF512")...と置換対象範囲を指定しても、ブック全体が対象になってしまいます。
Excelを再起動して実行してみてください。
現状のコードでも、少なくともSheets(1)の『りんご』が紅くなる事はないでしょう。

VBAコードでの回避策は、『置換』の前に空検索でもいいのでFindメソッドを実行する事です。
Cells.Find ""
これで[検索場所]を[シート]にリセットできます。

#余談ですが、逆に[検索場所]を[ブック]にする手段はVBAでは用意されていません。

#すみません、長々と書いてたら既出回答と一部ダブってしまいましたm(_ _)m
#後半の[検索場所]対策のほうを参考にしてみてください。
    • good
    • 0
この回答へのお礼

いやはや、そのとおり検索対象を「ブック」にしていました。
マクロを記録する際、ActiveSheetのむこうまで置換したいという思いからですが
どうも挙動が思い通りにいかなかったのはそれも原因でしょうか。
さらに検証してみたいと思います。なかなか時間が取れませんが・・・

皆様の回答がそれぞれ違う切り口なので大変勉強になります。
詳細な説明、ありがとうございました。
ポイントを差し上げられず申し訳ございません。

お礼日時:2009/05/19 04:02

まず、CurrentRegionで行数を取っていますが、F列に他の文字などが(長く)はいっているとE列の最終行にはなりません。


(これは大した問題でもないけれど…)

>ループを仕込んでいるにもかかわらず「みかん」の文字は赤くなりません
>どこでポカをやっているのでしょうか?
2回目のループで
>SearchLineID = Cells(i + 5, 5).Value
が実行されるときに、表示されているシートはもとのシートではないので、そのシートのE7などが参照されているはず。
(そこに何か値があれば、それと合ったセルが赤くなっているはずです)
(↑)これが、思うように動作しない原因と思われます。
 SearchLineID = WS.Cells(i + 5, 5).Value
などのようにシートを明示してあげれば、一応予定通りになると思います。

また、置換後のフォーマットの定義などは、ループの回数繰り返す必要がないので(毎回同じなので)、こういったものはループの外に出しておいたほうが良いでしょう。

使用条件等不明ですが、要旨だけでいけば、こんな感じでよいのかも。
(各シートのCells(=全セル)を対象にしています。)
Sub test()
Dim sht As Integer, rw As Long, v
Worksheets(1).Activate
Application.ReplaceFormat.Interior.ColorIndex = 3
Application.ReplaceFormat.Font.ColorIndex = 2

For rw = 6 To Cells(Rows.Count, 5).End(xlUp).Row
 v = Cells(rw, 5).Value
 If v <> "" Then
  For sht = 2 To Worksheets.Count
   Worksheets(sht).Cells.Replace What:=v, Replacement:=v, _
   LookAt:=xlWhole, ReplaceFormat:=True
  Next sht
 End If
Next rw
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございました。
こんな時間までマクロ書いてます・・・
>(そこに何か値があれば、それと合ったセルが赤くなっているはずです)
はい。そのとおりでした。これが直らず半泣きだったところにアドバイスを頂き
途中までは仕込むことができました。
しかし頂いた文を理解するのにもうしばらくかかり、その間に上記の方の文を頂いて
それで一応の解決を見ました。
(今は皆様から頂いた分の意味がある程度分かるようになりました)
これからもマクロとは付き合ってゆくことになりそうなので、もっと論理的思考を磨きたいと思います。

お礼日時:2009/05/19 04:15

長々と自分のコードを挙げて、読者に読ませるの。

それよリ
1例でよいから具体的にシートの一部の実例を挙げて、セル番地と内容を挙げて、コウだからコウしたいと説明してくれた方がありがたい。マクロの記録で置換操作をしてかんげれば、焦点がもっと狭まるのに。
(1)Sheets(1)のA列(他列に散りばめて無いだろうね)のキーワードの把握繰り返し。最終行の補足のコードなど必要。
(2)Sheet(2)意右のシートの繰り返し。For Each Next
これらをネストする。(2)が外側。
ーー
(1)の1つのキーワードで行うことは、
編集ー置換
検索する文字列  キーワード
置換する文字列  キーワード
オプションで書式(セルパターンやフォント色)を設定
に当たる捜査のマクロの記録をとる。質問のコードはそれに基づいたものかな。
マクロの記録では
Sub Macro1()
Range("A2:C15").Select
Application.ReplaceFormat.Interior.ColorIndex = 6
Selection.Replace What:="a", Replacement:="a", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=True
End Sub
変えるところといったらRange("A2:C15").Selectの部分だけ。
Sub test02()
For Each sh In Worksheets
If sh.Index <> 1 Then
MsgBox sh.Name
End If
Next
End Sub
のShをつけて各シートの範囲を記述する。範囲がどういう類型(同一か)か質問に書いてない。
==
やってみると、置換は
=A3のように、文字列を参照しているとその参照しているセルでは、ヒットしないことだ。セルの値で検索してくれるパラメーターは無いのかな。関係ないかな。
これが小生の誤解でなければ、対象全セル総なめで値をチェックしないとならないが。
一番左のタブのシートと言うのも不安定と思う。
    • good
    • 0
この回答へのお礼

厳しいご意見、身にしみます。全文添削しろといわんばかりのベタ貼りについてはお恥ずかしい限りです。
お察しのとおり、主導でマクロを記録したものを切り貼りしたため
変数の型やループの原理も怪しいものでした。いや、怪しいものです。
さらに式としての見栄えもヘボくお見苦しいところをご覧に入れてしまいました。
本当は皆さんにポイントを差し上げたいところですが
ピンポイントで回答をいただいた上記の方に20ptを差し上げ、
imogasi様にはその慮りから10ptとさせていただきました。
ありがとうございました。

お礼日時:2009/05/19 04:11

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング