2019/11/23

セルの文字を検出して、セル色を自動で変更する




セルに何か文字を入れた時に、その文字を感知してセルの色が変わってくれると、分類などに使えそうです。

１．セルの文字を取得し、その先頭文字によりセルの色を変更する

まず、ある特定のシートのセルに文字を入れた時、その先頭の文字を検出して設定済みの色をセルにつける　ことをしてみます。プログラムは、VBEのプロジェクトウィンドウの「Sheet1」等のシートをダブルクリックし、コードを記入してください。
シート固有のコードウィンドウに記入することで、そのシートのみで動くプログラムになります。

プログラム内容は、以下の通りです。
シート上のセルの値を変更する事で発生する「Worksheet_Changeイベント」に反応して作業をします。
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. 　Select Case Left(Target.Value, 1)
  3. 　　Case "a", "A"
  4. 　　　Target.Interior.Color = RGB(255, 0, 0)
  5. 　　Case "b", "B"
  6. 　　　Target.Interior.Color = RGB(0, 255, 0)
  7. 　　Case "c", "C"
  8. 　　　Target.Interior.Color = RGB(0, 0, 255)
  9. 　　Case Else
  10. 　　　Target.Interior.Color = RGB(128, 128, 128)
  11. 　End Select
  12. End Sub

準備が出来たら、コードを記入したシートのセルに文字を入れてみましょう。

先頭の文字が「a 又は A」なら赤色、「b 又は B」なら緑色、「c 又は C」なら青色、それ以外だったら灰色となります。うまく行きそうですね。

２．ユーザーの使い方を考えてみる

では、すこし意地悪操作をしてみましょう。
（意地悪Ａ）”Ａ１”セルの「Amazon」をDeleteで消してみましょう。消えてしまったのに灰色になりました。

（意地悪Ｂ）”Ｃ２”セルあたりをダブルクリックしてからその他のセルに移動してみて下さい。灰色になってしまいます。何も入っていないのに、です。ダブルクリックをすると、一旦編集モードに入るため、エスケープ（esc）をしない限り「セル値を変更した」というイベントが発生してしまうのです。


（意地悪Ｃ）文字を入れて色が変わったセルを選択してから、「ホーム」→「塗りつぶしの色」から「塗りつぶしなし」を選択してみましょう。文字が入っているのに色が塗られていない状態になります。何も記入していないセルで「塗りつぶしの色」を設定するのも同じようなものです。
他の色に変更するのも同様です


（意地悪Ｄ）セルに、全角（2バイト文字）で入力してみましょう。何を入れても灰色です。

（意地悪Ｅ）セルの文字の先頭にスペースを入れる（例「＿Amazon」(＿はスペースを表す)）と、灰色になる。ユーザー様は、セルの中での位置合わせ（セルの中央に持ってきたい、とか）で、良く使います。

（意地悪Ｆ）違うシートのセルに文字を入力し、そのセルに色を付けておきます。そのセルをコピーして「色付けイベントマクロ」のあるシートに貼り付けると、元の色から変わってしまいます。「仕方がない」とお思いでしょうが、ユーザーにとっては不満です。

（意地悪Ｇ）シートのシート名を変えてしまう。この操作による影響は今回はありませんが、プログラムの中でシート名を使っている時にはエラーが発生します。

（意地悪Ｈ）どこかのセルで連続したデータを入力後、 その複数のセルを選択したのちコピーをし、違うセルに貼り付けてみましょう。この場合は色がどうのこうのではなく、VBAの「実行時エラー」が発生してしまいます。プログラムに強くないユーザーが「実行時エラー」に遭遇するとパニックになります。


３．「実行時エラー」は発生しないようにする

使っている最中にエラーが出るのはプログラムを作っている側からすると最悪ですから、まず（意地悪Ｈ）の対策をしましょう。

さて、なんで実行時エラーが表示されるのでしょうか。エラーの内容は「型が一致していません」と出ていますよね。
どうやって調べるかと言うと、エラーが出たりコードウィンドウのブレイクポイントで実行を停止させている時に、イベントの引数「Target」を「ウォッチ式の追加」を設定するとウォッチウィンドウに表示されます。そのウォッチの結果を見てみましょう。

左側は１つのセルのみ操作した時、右側は２つのセルを操作（２つのセルをコピペ）した時です。ウォッチウィンドウ内のTargetの左端の＋印をクリックして、TargetのValue2プロパティの型を比べてみて下さい。

１つのセルのみ操作した時は「Variant/String」、２つのセルを操作した時は「Variant/Variant(1 to 1,1 to 2)」　になります。

「プログラム内には「Value」を使っているのに、なんで「Value2」で見るのか？」と思われるかもしれませんが、「Value2」は「Value」の値のシリアル値が入りますので、この文字を入力している限りは同じになります。異なる場合は日付などを入れた時です（日付2020/1/1とシリアル値43831の関係）。

プログラムの2行目は、Left(Target.Value, 1)　の計算をさせていますが、Left関数の第一引数には「文字列」を参照させないといけないのに、Variant(1 to 1,1 to 2)　という配列を与えているために「型が一致していません」と実行時エラーが出るのです
簡単に言えば、「Target.Valueには２つの値が入っているけど、どちらを使えば分からない」と怒られているのです。

ではどうすれば良いか。Target.Valueが複数のセルを持っているのであれば、１つずつ順番に取り出していけば良さそうです。
複数の値を収納できる配列などから、一つずつ取り出すには「For Each ～　Next」という構文が使えます。元のプログラムを改造してみましょう。
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. 　For Each sim_TargetValue In Target.Value
  3. 　　Select Case Left(sim_TargetValue, 1)
  4. 　　　Case "a", "A"
  5. 　　　　sim_TargetValue.Interior.Color　・・・・あれ？
もとのプログラムの4行目はの、Target.Interior.Color = RGB(255, 0, 0) で分かる通り、セルの色（Interior.Color）はTarget.Value　の下に付くのでは無くTarget　の下に付きますのでうまく行きません。
実は、Target.Valueは配列になっているのと同様に、Targetも配列になっているのです。ですからTargetに対して１つずつ順番に取り出していきましょう。
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. 　For Each sim_Target In Target
  3. 　　Select Case Left(sim_Target.Value, 1)
  4. 　　　Case "a", "A"
  5. 　　　　sim_Target.Interior.Color = RGB(255, 0, 0)
  6. 　　　Case "b", "B"
  7. 　　　　sim_Target.Interior.Color = RGB(0, 255, 0)
  8. 　　　Case "c", "C"
  9. 　　　　sim_Target.Interior.Color = RGB(0, 0, 255)
  10. 　　　Case Else
  11. 　　　　sim_Target.Interior.Color = RGB(128, 128, 128)
  12. 　　End Select
  13. 　Next sim_Target
  14. End Sub

もちろん他の方法でも動きます。例えば「Target.count」で選択したセルは何個かを取得し、また個々のセルはTarget(1)、Target(2)、Target(3)・・・で取得できますので、for～next を使って回すやり方でもＯＫです。
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. 　dim count As Integer
  3. 　For count=1 to Target.count
  4. 　　Select Case Left(Target(count).Value, 1)
  5. 　　　Case "a", "A"
  6. 　　　　Target(count).Interior.Color = RGB(255, 0, 0)
  7. 　　　Case "b", "B"
  8. 　　　　Target(count).Interior.Color = RGB(0, 255, 0)
  9. 　　　Case "c", "C"
  10. 　　　　Target(count).Interior.Color = RGB(0, 0, 255)
  11. 　　　Case Else
  12. 　　　　Target(count).Interior.Color = RGB(128, 128, 128)
  13. 　　End Select
  14. 　Next count
  15. End Sub

４．色々な使い方をされても、予定した通りに動くようにする

上で示した「意地悪」を、操作されたあとの状況で整理してみましょう。
（意地悪Ａ）文字を削除する　　　　　　　　　→　空欄になった
（意地悪Ｂ）一旦編集モードにする　　　　　　→　空欄になった
（意地悪Ｃ）セル色を別な色に設定　　　　　　→　セル色をユーザーが変更した
（意地悪Ｄ）２バイト文字を入力　　　　　　　→　２バイト文字を使った
（意地悪Ｅ）文字の先頭にスペースを入れる　　→　入力文字列の先頭にスペースがある
（意地悪Ｆ）シート間でセルの色設定が異なる　→　セル色変更のマクロがシート間で異なる
（意地悪Ｇ）シートの名前を変えてしまう　　　→　シート名が変更される

4-1.空欄時のセル色設定

では、（意地悪Ａ・Ｂ）に対応させましょう。「空欄になった」のですから、「Target.Value」には何も入っていませんよね。ですからSelect Case のCaseの１つに「""（空セル）」を加えれば良さそうです。また、IsEmpty(Target.Value)がTrueになることから、if文で「セル色を無し」に設定しても良いでしょう。
また、ダブルクリックを防止するために「Worksheet_BeforeDoubleClick」のイベントで「Cansel=True」を設定しても良いのですが、文字を編集したい時には少し不便かもしれません。それにファンクションキーF2での編集はできますので、エスケープ（ESC）をせずにそのまま確定してしまうと、やはりセル色が変わってしまうため、確実ではありません。
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. 　For Each sim_Target In Target
  3. 　　Select Case Left(sim_Target.Value, 1)
  4. 　　　Case ""
  5. 　　　　sim_Target.Interior.Pattern = xlNone
  6. 　　　Case "a", "A"
  7. 　　　　sim_Target.Interior.Color = RGB(255, 0, 0)
  8. 　　　Case "b", "B"
  9. 　　　　sim_Target.Interior.Color = RGB(0, 255, 0)
  10. 　　　Case "c", "C"
  11. 　　　　sim_Target.Interior.Color = RGB(0, 0, 255)
  12. 　　　Case Else
  13. 　　　　sim_Target.Interior.Color = RGB(128, 128, 128)
  14. 　　End Select
  15. 　Next sim_Target
  16. End Sub
尚、セル色を白にする（sim_Target.Interior.Color = RGB(255, 255, 255)）のも１つの方法ですが、四方の罫線も無くなってしまいますので、今回は「塗りつぶしを無し」に設定してみました。

4-2.ユーザーが設定変更してしまった時の修正

次に（意地悪Ｃ）のセル色を自分で変更した時の対策です。自分でセル色を変更した後は、どこかの違うセルに移動するはずですので、移動元のセル情報からセル色が正しいか否かを調べれば良いと思われます。
しかしそれは、ちょっと面倒なのです。というのも「Worksheet_SelectionChange」では移動後のセル情報しか取得できませんし、「セルが移動する直前に発生（before_selectionChange ?）」みたいなイベントもありません。移動前のセル情報を取得するようなプログラムを自分で作るしかなさそうです。
まず、移動前のRangeオブジェクトとして、before_cellをシートの先頭で宣言します（そのシート上のどのマクロからも使えるように）。移動後のセルは、「Worksheet_SelectionChange」で取得できますので、移動してきたら次に移動するときのために、Targetをbefore_cellに代入します。
  1. Dim before_cell As Range
  3. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  4. 　Set before_cell = Target　　　'←移動後の情報を次に移動する時のために保存
  5. End Sub
但し、これだとExcelを開いた時に選択されていたセルの情報はbefore_cellに保存されていません（開いた途端に変な操作まをするのは、確信犯だとは思いますが）。ですので、最初に選択されていたセル情報を保存するために、Excelファイルを開いた時にイベント発生する「Workbook_Openイベントプロシージャ」をThisworkbookに作成します。そして、シート側のマクロ（ここでは、start_cell　としました）で、現時点でのセル情報をbefore_cellに代入します。
  1. ’シート側に作成するマクロ
  2. Sub start_cell()
  3. 　Set before_cell = ActiveCell　　　'←WorkbookのWorkbook_Openイベントで呼び出されるマクロ
  4. End Sub
  1. ’ブック側（Thisworkbook）に作成するマクロ
  2. Private Sub Workbook_Open()
  3. 　Application.Run ("Sheet1.start_cell")
  4. End Sub
これで、１つ前のセル情報が保存できました。

次に、その１つ前のセル色が正しいか否か　をどうやって調べるか、です。「セルに書かれた文字を調べてセル色が正しいか調査し、間違っていれば修正する」まあ、人間の頭だとこんな手順でしょう。それをプログラムにすると以下の通りです。
  1. Sub cell_check()
  2. 　Dim Target As Range
  3. 　　Set Target = before_cell
  4. 　For Each sim_Target In Target
  5. 　　Select Case Left(sim_Target.Value, 1)
  6. 　　　Case ""
  7. 　　　　If sim_Target.Interior.Pattern <> xlNone Then
  8. 　　　　　sim_Target.Interior.Pattern = xlNone
  9. 　　　　End If
  10. 　　　Case "a", "A"
  11. 　　　　If sim_Target.Interior.Color <> RGB(255, 0, 0) Then
  12. 　　　　　sim_Target.Interior.Color = RGB(255, 0, 0)
  13. 　　　　End If
  14. 　　　Case "b", "B"
  15. 　　　　If sim_Target.Interior.Color <> RGB(0, 255, 0) Then
  16. 　　　　　sim_Target.Interior.Color = RGB(0, 255, 0)
  17. 　　　　End If
  18. 　　　Case "c", "C"
  19. 　　　　If sim_Target.Interior.Color <> RGB(0, 0, 255) Then
  20. 　　　　　sim_Target.Interior.Color = RGB(0, 0, 255)
  21. 　　　　End If
  22. 　　　Case Else
  23. 　　　　If sim_Target.Interior.Color <> RGB(128, 128, 128) Then
  24. 　　　　　sim_Target.Interior.Color = RGB(128, 128, 128)
  25. 　　　　End If
  26. 　　End Select
  27. 　Next sim_Target
  28. End Sub
マクロ名をcell_checkにして、「Worksheet_SelectionChange」から呼び出そうという考えです。確かにこれでも動くのですが、色の設定を増やしたり変更したりする場合、設定側のイベントプロシージャ「Worksheet_Change」と同時にこちらも併行して修正しなければならず、間違いの元になります。それに同じような行が並んでいて無駄ですよね。
そこで、「一つ前のセルに一つ前のセルの値を書き込む」というのはどうでしょう。書き込めば、「Worksheet_Change」イベントが発生して、セル色をもう一度設定してくれます。それをプログラムにしてみました。
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2. 　before_cell = before_cell.Value
  3. 　Set before_cell = Target
  4. End Sub
1行で済みましたし、何より設定ミスも重複作業もないですよね。

4-3.２バイト文字の対応

case文で「２バイト文字の時は・・・」と並べる方法もありますが、Ａ・Ｂ・Ｃ・・（２バイト）とA・B・C・・（１バイト）でセル色を分けないのであればもう少し簡単な方法があります。２バイト文字を１バイト文字に変換する関数を使いましょう。
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. 　For Each sim_Target In Target
  3. 　　Select Case Left(StrConv(sim_Target.Value,vbNarrow), 1)
  4. 　　　Case ""
  5. 　　　　sim_Target.Interior.Pattern = xlNone
  6. 　　　Case "a", "A"
  7. 　　　　sim_Target.Interior.Color = RGB(255, 0, 0)
  8. 　　　Case "b", "B"
  9. 　　　　sim_Target.Interior.Color = RGB(0, 255, 0)
  10. 　　　Case "c", "C"
  11. 　　　　sim_Target.Interior.Color = RGB(0, 0, 255)
  12. 　　　Case Else
  13. 　　　　sim_Target.Interior.Color = RGB(128, 128, 128)
  14. 　　End Select
  15. 　Next sim_Target
  16. End Sub
尚、「Case "a", "A"」などと大文字・小文字を併記していますが、これも「StrConv(sim_Target.Value,vbUpperCase)」 とか「UCase(sim_Target.Value)」を使えば、「Case "A"」に統合が出来ます。

4-4.文字列の先頭にスペースがある

入力文字列の先頭の１文字を取り出して比較していますので、スペースが先頭に入ると都合が悪くなります。スペースを取り除くのは、「Trim」,「LTrim」,｢RTrim」関数ですが、今回は先頭のスペース削除でよいので「LTrim」でよいでしょう。
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. 　For Each sim_Target In Target
  3. 　　Select Case Left(StrConv(LTrim (UCase (sim_Target.Value) ) ,vbNarrow), 1)
  4. 　　　Case ""
  5. 　　　　sim_Target.Interior.Pattern = xlNone
  6. 　　　Case "A"
  7. 　　　　sim_Target.Interior.Color = RGB(255, 0, 0)
  8. 　　　Case "B"
  9. 　　　　sim_Target.Interior.Color = RGB(0, 255, 0)
  10. 　　　Case "C"
  11. 　　　　sim_Target.Interior.Color = RGB(0, 0, 255)
  12. 　　　Case Else
  13. 　　　　sim_Target.Interior.Color = RGB(128, 128, 128)
  14. 　　End Select
  15. 　Next sim_Target
  16. End Sub


4-5.シート間でマクロが異なる

複数のシートで同じマクロを動かしたい場合、各シートに同じコードを記入すれば動きます。でもいくらコピーが簡単にできると言っても、同じようなコードがあちこちに存在するのは、分かりにくいばかりか修正の際の間違いにもつながります。
シートの上流はブックですので、複数のシートで使うマクロはブックである「thisworkbook」に作成すれば良いのです。
但し、ブックで発生するイベントは、シートのとは少し異なります。
シート：Worksheet_Change(ByVal Target As Range)
ブック：Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

シート：Worksheet_SelectionChange(ByVal Target As Range)
ブック：Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

見てわかる通り、ブックの方のイベントプロシージャには「ByVal Sh As Object」という引数が増えています。 Shというスペルはシート（Sheet）名を表しています。どのシートのどのセルで発生したかを受け取れます。
尚、シート共通のマクロは、シート毎の動作させるさせないを引数のShから判断するようにします。

「thisworkbook」に下記のコードを記入します。Sheet1とSheet3のみで実行するようにしています。
  1. Dim before_cell As Range
  3. Private Sub Workbook_Open()
  4. 　Set before_cell = ActiveCell
  5. End Sub
  7. Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  8. 　before_cell = before_cell.Value
  9. 　Set before_cell = Target
  10. End Sub
  12. Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  13. 　before_cell = before_cell.Value
  14. 　Set before_cell = ActiveCell
  15. End Sub
  17. Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  18. 　if Sh.Name = "Sheet1"　Or　Sh.Name = "Sheet3" then
  19. 　　For Each sim_Target In Target
  20. 　　　Select Case Left(StrConv(LTrim(UCase(sim_Target.Value)), vbNarrow), 1)
  21. 　　　　Case ""
  22. 　　　　　sim_Target.Interior.Pattern = xlNone
  23. 　　　　Case "A"
  24. 　　　　　sim_Target.Interior.Color = RGB(255, 0, 0)
  25. 　　　　Case "B"
  26. 　　　　　sim_Target.Interior.Color = RGB(0, 255, 0)
  27. 　　　　Case "C"
  28. 　　　　　sim_Target.Interior.Color = RGB(0, 0, 255)
  29. 　　　　Case Else
  30. 　　　　　sim_Target.Interior.Color = RGB(128, 128, 128)
  31. 　　　End Select
  32. 　　Next sim_Target
  33. 　end if
  34. End Sub

4-6.シート名が変更されてしまう

Sh.Name　は、シートのタブに表示されている名前（変更可）ですが、Sh.CodeName は不変です。どこで調べればわかるかと言うと、プロジェクトウィンドウに表示されているシート名の部分で、カッコ付きの方がユーザーが変更できる名前でシートのタブに表示されているものです。そしてカッコの左側がCodeNameとなります。
ですので、ユーザーに変更されてもエラーが出ないようにするには、Name を CodeName　にします。上の例での18行目を書き換えた例を示します。
ただし「"Sheet1"」と「"Sheet1"」の様に大文字小文字は区別されますので、注意が必要です。VBEではシートのCodeName（シートのオブジェクト名）は変更可能ですので、紛らわしく無い命名をすると良いと思います。
  1. 　if Sh.CodeName = "Sheet1"　Or　Sh.CodeName = "Sheet3" then


5.最後に

意図する・しないに限らず、思いもしない使い方をされて困った人も多いと思います。ユーザー様（のヤロー）の行動をどこまで読めるかもプログラムを作る人の腕のひとつだと思います。