VBA リストを参照して文字色を変える

質問

リスト表と一覧表の２つの表があるとします。
例えば。
リストの中に下記が入力されています。
ああああ
いいいい
うううう
ええええ
おおおお
このリストを参照して
一覧表にも“ああああ”があったら
その文字を赤くする。
このマクロの組み方を教えてください。
宜しくお願いします。

回答No.6

noname#144013 · ベストアンサー

こんにちは。　FarEyesです。

> この後の作業は
> どうしたら良いのでしょうか??
> (赤くさせる為には…）
>
> 今まではオブジェクトにマクロを登録して
> ポッチで実行させてたんですが
> その方法で出来ますか??

今回のマクロは、「標準モジュール」に作成するようなマクロ（引数なしの関数形式のもの）
のように、「マクロ実行ボタン」から実行するようなマクロではありません。

今回のマクロは、シート上の、
　　・セルに値（文字列）を入れた時。
　　・セルの値（文字列）を変更した時。（同じ値を入れた場合も含む）
のタイミングに発生する、『セルの値が変更された』というイベント（Excelがシート
オブジェクトに対して送る通知）を、シートオブジェクトが受け取った時に、実行され
るマクロです。（※ワークシートのイベントプロシージャという種類のマクロです。）
（※少し専門的で難しい話しなので、今は理解されなくても構いません。）

要するに、「セルに値を入れた時」、及び、「セルの値を変更した時」に、実行される
マクロです。

ですので、今回のマクロは、既にセルに入っている値（文字列）に対しては、適用
されません。
既存のセルの文字色を変更する（赤くさせる）ためには、「一覧表」側のセルの値
（文字列）を、『もう一度入れ直す』（同じ値を入れる）必要があります。

「一覧表」側のセルの値（文字列）を入れ直す（同じ値を入れる）には、
　　１）「一覧表」側の先頭のセル（一番上の行のセル）を選択します。
　　　　・マウスのワンクリックで選択状態にします。
　　２）ファンクションキーの[F2]キーを押します。
　　　　・これで、セルの値が入力（変更）できる状態になります。
　　　　・セル内のカーソル位置は、「文字列」の後の一番右端にあると思います。
　　３）そのまま、[Enter]キーを押します。
　　　　・これで、セルの選択状態が次の行のセル（標準の設定ならば）に移動します。
　　　　・この際、入力した文字列が、「リスト」側に登録してあれば、文字色が「赤」色
　　　　　で表示される筈です。（※これで、マクロが正常に実行されたということです。）
　　４）上記３）で、セルの選択位置が次の行に移動したら、上記２）～３）の操作を
　　　　「一覧表」セルの終端（最後の行）まで繰り返します。
以上のような操作を行って下さい。
※もっと簡単な方法があるかもしれませんが、取りあえず思い浮かんだ操作です。

「一覧表」側セルの行範囲を拡張（下方向への行追加）を行った際の、最後の空欄
セルから下方向に、新たに「文字列」を追加していく際にも、マクロは適用されると
思います。
※マクロの設定では、シートの最終行（F列のみ）までカバーするようにしています。

■補足
今回の件とは、直接関係ない話しなので、以下は蛇足になりますが、
どうやら、質問者さんは、Excel VBAの基本的なことから学ばれた方がよさそう
ですので、参考になりそうなサイトを紹介致します。

＜参考サイト＞
◎Excel VBA 入門講座
http://excelvba.pc-users.net/

◎Excel(エクセル)VBA入門
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/index.html

できれば、Excel VBA関係の「入門書」なり「解説書」なりを一冊、ご用意されて
その中に掲載されているサンプルマクロなどを、実際に自分で入力＆実行して
試してみる作業を、繰り返し行ってみて下さい。
そして、作成したマクロを適当にいじってみて下さい。
※エラーが出ても構いません。原因はそのうち解ってくると思います。

以上のような作業が、手っ取り早い学習方法かもしれません。

最初は何をやっているか理解できなくても構いません。
とにかく、実際の動作を『体感』してみるのが良い経験になるかと思います。
⇒『習うより、慣れろ』です。

以上です。

お礼

FarEyes様
何度も何度もありがとうございました。
自分でも色々試して見ます。
また何かあった時は宜しくお願いします。
初心者の私に親切にして頂いてありがとうございました。

回答No.5

noname#144013

こんにちは。　FarEyesです。

ひょっとして、「標準モジュール」にコピぺされていませんか？

今回のマクロは、「標準モジュール」ではなく、ワークシート側のコードモジュールに
実装するマクロです。

以下の操作を行って下さい。

１）VBE画面で、画面左側に「プロジェクトエクスプローラ」のツリー画面が表示されて
　　いると思いますが、
　　もしも、表示されていなければ、
　　　　「表示」　→　「プロジェクトエクスプローラ」
　　をクリックして表示させて下さい。

２）その中に、「VBAProject（Excelブックのファイル名）」のように書かれているもの
　　があると思います。
　　※その部分をダブルクリックすると、ツリーが展開されると思います。

３）そのツリーの中に、「Sheet1（シート名）」とか「Sheet2（シート名）」のように書か
　　れているものがあると思います。
　　※これが、ワークシートのコードモジュールで、ワークシートと１対１に対応して
　　　います。

４）この「プロジェクトエクスプローラ」のツリー内の、対象シート（「リスト」のセル及び
　「一覧表」のセルを設定したワークシート）に対応した、シートのコードモジュールを
　ダブルクリックすると画面の右側に、「コード画面」が表示されると思います。

５）この「コード画面」に、#3のコードを、「そのまま」貼り付けて下さい。

/////↓ここから//////////
Option Explicit
'
'== シートのセルの値変更時のイベント処理 ==
Private Sub Worksheet_Change(ByVal Target As Range)
　　　　：
　　　　：
End Sub
/////↑ここまで//////////

※もしも、"Option Explicit"の行が、既にあった場合は、コピペした側の１行を
　削除して、１箇所のみにして下さい。

６）それから、「標準モジュール」にコピペしたコードは、全て削除して下さい。

７）VBEの画面で、「デバッグ」→「VBA Projectのコンパイル」でコンパイルを
　　行ってみて下さい。
　　※もしも、ここで何かしらのエラーが表示された場合は、
　　　　　「エラー発生箇所のコード内容」　と　「表示されたエラーメッセージ」
　　　を、ご報告願えないでしょうか？
　　　もしくは、「ヘルプ」などを参照して、ご自身でエラーを修正して下さい。

８）上記７）で何もエラーが表示されなかった場合は、Excelのシート画面に
　　戻って下さい。

９）念のため、ここで一旦、Excelブックを「保存」して下さい。

１０）ワークシートの「一覧表」のセルに、適当な文字列を入れて[Enter]キー
　　を押して下さい。
　　※これで、セル更新のイベントが発生し、マクロが実行されると思います。
　　※ここで、もしも、エラーが発生し場合は、
　　　　　「エラー発生箇所のコード内容」　と　「表示されたエラーメッセージ」
　　　を、ご報告願えないでしょうか？
　　　もしくは、「ヘルプ」などを参照して、ご自身でエラーを修正して下さい。

※添付画像は、VBE画面をキャプチャしたものです。

以上です。

補足

ありがとうございます。
エラーなく貼付けが出来ました。
セルに文字を入れてもエラーは出ませんでした。

この後の作業は
どうしたら良いのでしょうか??
(赤くさせる為には…）

今まではオブジェクトにマクロを登録して
ポッチで実行させてたんですが
その方法で出来ますか??

無知で申し訳ありません。

回答No.4

noname#144013

こんにちは。　FarEyesです。

＞ そのままコピーぺしてやってみました。

何処に（どのモジュールに？）コピーされたのでしょう？

#3の改造前のExcelブック（#2のコードが実装された時点のExcelブック）にコピー
されたのでしょうか？
その場合、改造前のコードを「全て削除」した上でコピーされたのでしょうか？
昔のコードが残っていて重複しているような部分はないでしょうか？

※マクロコードなどを修正・改造する場合は、修正前のExcelブックはそのままに
　しておいて、別ファイルとしてExcelブックを保存してから修正を加えるか、新しい
　Excelブックを作成し、そこに旧コードをコピー＆ペーストして修正を加えるように
　した方が良いと思います。

こちらでは、ご提示のエラーが再現できないので、原因がつかめないのですが、
念のため、以下の操作を行ってみて下さい。

１）Excelを起動して、「ファイル」→「新規作成」で、新しいブック（何も手を加えて
　　いない、まっさらなExcelブック）を作成して下さい。

２）作成したブックで、「Visual Basic Editor（VBE）」を起動して、シート１（Sheet1）
　　のコードモジュールへ、#3のコードをコピー＆ペーストして貼り付けて下さい。

３）VBEの画面で、「デバッグ」→「VBA Projectのコンパイル」でコンパイルを
　　行ってみて下さい。
　　※もしも、ここで何かしらのエラーが表示された場合は、
　　　　　「エラー発生箇所のコード内容」　と　「表示されたエラーメッセージ」
　　　を、ご報告願えないでしょうか？
　　　もしくは、「ヘルプ」などを参照して、ご自身でエラーを修正して下さい。

４）上記３）で何もエラーが表示されなかった場合は、VBE画面を閉じて、Excelの
　　シート画面に戻って下さい。

５）シート１（Sheet1)に、必要な「リスト」データと、「一覧表」の枠のみ（※ここ
　　では、まだデータは記入しない）を作成して下さい。

６）ここで、一旦Excelブックを、「名前を付けて保存」で保存したのち、続けて、
　　Excelを終了させて下さい。
　　※他のExcelブックを開いていた場合は、そのブックも終了させて下さい。
　　　（Excelが完全に起動されていない状態にします。）

７）上記６）で保存したExcelブックを、再び開いて下さい。
　　※この際、マクロを有効にして下さい。

８）シート１（Sheet１）の「一覧表」のセルに、適当な文字列を入れて[Enter]キー
　　を押して下さい。
　　※これで、セル更新のイベントが発生し、マクロが実行されると思います。
　　※ここで、もしも、エラーが発生し場合は、
　　　　　「エラー発生箇所のコード内容」　と　「表示されたエラーメッセージ」
　　　を、ご報告願えないでしょうか？
　　　もしくは、「ヘルプ」などを参照して、ご自身でエラーを修正して下さい。

以上です。

補足

本当にお手数をお掛けして申し訳ありません。
はじめてVBAを言葉を聞いたばかりなのに
会社でマクロの作成を迫られまして。。。
ごめんなさい。

コピペしたときはマッサラなところから始めたので
上書きなどはしてません。

色々試したエラーをお伝えしたいと思います。

●そのまま（Option ExplicitからEnd Subまで）して
《F８》を押すとただエラーの音がするだけでした。

●Option Explicitだけを消してらSub sample1()を投入したら
End Subが必要ですというエラーが出ました。

●Private Sub Worksheet_Change(ByVal Target As Range)に
'コメント（反映しないように）したら
If Intersect(Target, Range("$F4:$F" & Rows.Count)) Is Nothing Then　　がエラーになりました。

●あとは色々いじってる間に気がついたのは
“Target”がいつもエラーになってました。

※〔ツール〕→〔オプション〕→〔変数の宣言を強制する〕の
レ点は外してあります。

上手く説明できなくて申し訳ありません。
お手数をお掛けしますが宜しくお願いします。

回答No.3

noname#144013

こんにちは。　#2です。

> この方法は文字が一致した場合ですが
> 一部の文字があった場合も赤くするには
> どうしたら良いのでしょうか??

ご要望を解釈しますと、
　　「一覧表」側に入れた「文字列」
の中に、
　　「リスト」側に登録した「文字列」
が『含まれていた場合』に、「文字色を変更する」ということでしょうか？

言い換えますと、例えば、「リスト」側に、
　　そば
という「文字列」が登録されていた場合で、「一覧表」側に、
　　そば
と入れた場合でも、
　　ざるそば
と入れた場合でも、
　　そばつゆ
と入れた場合でも、「文字色を変更する」ということでしょうか？

そうであった場合ですが、文字列の比較の際に、「Like演算子」を使用すれば
対応可能かと思います。

#2のマクロに、上記の改造を行ったものを掲載致します。
変更箇所は、見ていただければ解るかと思います。
※コード内の、"@1"とコメントしてある部分が、追加＆変更した箇所です。

■改造後のマクロ
注）インデント等のため全角スペースを入れています。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Option Explicit
'
'== シートのセルの値変更時のイベント処理 ==
Private Sub Worksheet_Change(ByVal Target As Range)

　　Dim nListEnd As Long　　'「リスト」側のセル範囲の最終行の位置
　　Dim rgList As Range　　 '「リスト」側のセルオブジェクト取得用
　　Dim bFind As Boolean　　'一致文字列の「あり／なし」判定フラグ
　　Dim sPattern As String　'一致文字列を含む検索文字列（@1:追加）

　　'入力セルが「一覧表」側のセル範囲にあるかチェック
　　'※ここでの「一覧表」側のセル範囲の最終行はシートの最終行に設定しています。
　　If Intersect(Target, Range("$F4:$F" & Rows.Count)) Is Nothing Then
　　　　Exit Sub　'なければ戻る
　　End If

　　'入力セルが「空き」かチェック
　　If Target.Text = "" Then
　　　　Exit Sub　'「空き」なら戻る
　　End If

　　'「リスト」側のセル範囲の最終行の位置を取得
　　nListEnd = Range("$B" & Rows.Count).End(xlUp).Row

　　'「リスト」側のセル範囲をループして一致する文字列を含んでいるかを
　　'チェックする
　　bFind = False　　　　 '一致フラグを「なし」で初期化
　　For Each rgList In Range("$B4:$B" & nListEnd)
　　　　sPattern = "*" & rgList.Text & "*"　'検索文字列を作成（@1:追加）
　　　　If Target.Text Like sPattern Then　 '文字列の比較（@1:変更）
　　　　　　'入力セルの文字列が「リスト」内の文字列を含んでいた場合
　　　　　　bFind = True　'一致フラグを「あり」とする
　　　　　　Exit For　　　'ここでループを抜ける
　　　　End If
　　Next

　　'一致の「あり／なし」により入力セルのフォント色を設定
　　'※色番号は、標準のカラーパレットのカラーインデックス番号を使用しています。
　　If bFind = True Then
　　　　'一致あり（リスト内に同一文字列があった）の場合
　　　　Target.Font.ColorIndex = 3　'フォントの表示色を「赤」に設定
　　Else
　　　　'一致なし（リスト内に同一文字列がなかった）の場合
　　　　Target.Font.ColorIndex = 1　'フォントの表示色を「黒」に設定
　　End If

End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

参考までに、上記改造後のシート画面のキャプチャ画像を添付しています。

以上です。

補足

ありがとうございます。

そのままコピーぺしてやってみました。

実行時エラー'424'
オブジェクトが必要です。

となってしまいました。
エラーが出てる箇所は
If Intersect(Target, Range("$F4:$F" & Rows.Count)) Is Nothing Then　です。

朝最初に回答いただいたのをやってみた時は出来たのですが…。

'コメントにしてみたら
次のIfのところでもエラーが出てしまいました。

何度も何度も申し訳ありません。
改善方法を教えてください。
宜しくお願いします。

回答No.2

noname#144013

こんにちは。

当方もマクロの一例を作成してみました。

#1さんご提示の２番目の方法と同じく、一覧表側のセルの値が変更
された際のイベント処理による方法です。

■サンプルマクロ
注）インデント等のため全角スペースを入れています。

※以下のコードは、対象シートのコードモジュールに貼り付けて下さい。
※コード内の「リスト」側のセル範囲及び、「一覧表」側のセル範囲は、
　ご使用の環境に合わせて、適せん変更して下さい。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Option Explicit
'
'== シートのセルの値変更時のイベント処理 ==
Private Sub Worksheet_Change(ByVal Target As Range)

　　Dim nListEnd As Long　'「リスト」側のセル範囲の最終行の位置
　　Dim rgList As Range　 '「リスト」側のセルオブジェクト取得用
　　Dim bFind As Boolean　'一致文字列の「あり／なし」判定フラグ

　　'入力セルが「一覧表」側のセル範囲にあるかチェック
　　'※ここでの「一覧表」側のセル範囲の最終行はシートの最終行に設定しています。
　　If Intersect(Target, Range("$F4:$F" & Rows.Count)) Is Nothing Then
　　　　Exit Sub　'なければ戻る
　　End If

　　'入力セルが「空き」かチェック
　　If Target.Text = "" Then
　　　　Exit Sub　'「空き」なら戻る
　　End If

　　'「リスト」側のセル範囲の最終行の位置を取得
　　nListEnd = Range("$B" & Rows.Count).End(xlUp).Row

　　'「リスト」側のセル範囲をループして一致する文字列があるかチェック
　　bFind = False　　　　 '一致フラグを「なし」で初期化
　　For Each rgList In Range("$B4:$B" & nListEnd)
　　　　If Target.Text = rgList.Text Then
　　　　　　'入力セルの文字列が「リスト」内の文字列と一致した場合
　　　　　　bFind = True　'一致フラグを「あり」とする
　　　　　　Exit For　　　'ここでループを抜ける
　　　　End If
　　Next

　　'一致の「あり／なし」により入力セルのフォント色を設定
　　'※色番号は、標準のカラーパレットのカラーインデックス番号を使用しています。
　　If bFind = True Then
　　　　'一致あり（リスト内に同一文字列があった）の場合
　　　　Target.Font.ColorIndex = 3　'フォントの表示色を「赤」に設定
　　Else
　　　　'一致なし（リスト内に同一文字列がなかった）の場合
　　　　Target.Font.ColorIndex = 1　'フォントの表示色を「黒」に設定
　　End If

End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

因みに、今回の処理は、マクロを使用しなくても、ワークシート側の「条件付き書式」
の設定による方法でも対応可能だと思います。

以下は、その設定方法の一例です。

■「条件付き書式」設定による設定手順
注）Excelのバージョンにより、操作方法などが違う場合があります。
　　※当方は、Excel2000で試してみました。

１）色を付けたい側（「一覧表」側）のセル範囲を選択します。
　　ご提示の画像の場合、F4～F13 のセル範囲になります。

２）メニュー操作
　　「書式」　→　「条件付き書式」　をクリックします。

３）「条件付き書式の設定」のダイアログ画面の操作
　◎条件１の設定
　　・左端のコンボボックスのリストより、「数式が」を選択
　　・その右横の「数式」の欄に、下記の数式を設定
　　　　=ISERROR(MATCH(F4,$B$4:$B$65536,0))=FALSE
　　　　※"$B$4:$B$65536" の部分は、「リスト」側のセル範囲を指定します。
　　・[書式]ボタンをクリック
　　　　・表示された「セルの書式設定」ダイアログ画面の、[フォント]タブを選択
　　　　　して、フォントの「色」を、表示させたい色に設定します。
　　　　・[OK]ボタンをクリックします。
　　・元のダイアログ画面に戻ったら、[OK]ボタンをクリックしてダイアログを閉じ
　　　ます。

以上で、設定完了です。
※添付画像は、上記の「条件付き書式の設定」画面のキャプチャ画像です。

以上です。参考になれば幸いです。

補足

ありがとうございます。
もう１つお聞きしたい事があります。
この方法は文字が一致した場合ですが
一部の文字があった場合も赤くするには
どうしたら良いのでしょうか??
↓↓
bFind = False
修正すれば良いですか??

すみません。
VBAをはじめたばかりなので…
宜しくお願いします。

回答No.1

avanzato

簡単な作りですが多分動くと思われます。
一覧の行数が多いときは画面更新のコメントを解除してください。
Sub リストを参照して文字色を変える()
On Error Resume Next
'Application.ScreenUpdating = False
Dim Ret As Long
Dim I As Long
I = 4
Do While Range("F" & I).Value <> ""
Ret = 0
Ret = Application.WorksheetFunction.Match(Range("F" & I).Value, Range("B4:B12").Value, 0)
'リストの行数が増える場合は↑変更必要
If Ret = 1 Then
Range("F" & I).Font.ColorIndex = 3
Else
Range("F" & I).Font.ColorIndex = 0
End If
I = I + 1
Loop
'Application.ScreenUpdating = True
End Sub
別の方法で一覧の入力時に色を付ける場合は↓
Private Sub Worksheet_Change(ByVal Target As Range)
'リスト・一覧の行数が増えてもメンテナンスフリー
Dim I As Long
I = 4
If Target.Column = 6 Then　'F列=6
Target.Font.ColorIndex = 0
Do While Range("B" & I).Value <> ""
If Range("B" & I).Value = Target.Value Then
Target.Font.ColorIndex = 3
Exit Sub
End If
I = I + 1
Loop
End If
End Sub
で、如何でしょうか？