- ベストアンサー
Excelのマクロでセル内の数値によってセルの色分け
はじめまして。マクロ初心者です。 よろしくお願いいたします。 エクセルに入力されている数値によってセルを色分けしたいのです。 数値はこんなふうに入力されています↓ A0*22*33*44 B1*22*33*44 A2*12*55*66 D1*77*22*88 C1*12*55*66 E2*99*12*11 こういったものが全部で1500行ほどです。 *は空白を表しています。 この中の、空白を入れて左から4つめの数字が2、5つめが2のときは赤、 左から4つめの数字が1、5つめの数字が2のときは青、 それ以外のときはそのまま… といった具合に全部で5種類5色に色分けしたいのですが、どうにも能力が足りなくて困っています。 最初、自分なりにネット等参考にしながら「22という数値を含むセルは赤」といったように作ったのですが、 どうしても左から4文字目5文字目に限定しないと余計なセルにも色が付いてしまうのです。 もう2日も悩んでいますが、どうにも手も足も出ません。 ご指導いただけると本当に助かります。 どうぞよろしくお願いいたします。
- みんなの回答 (3)
- 専門家の回答
質問者が選んだベストアンサー
こんにちは。 >こういったものが全部で1500行ほどです。 >*は空白を表しています。 間の空白が、半角であり、空白は1つであるという確約はないと思うのですね。 1500行で、数多くある場合は、そういうことを想定しないといけないような気がします。 私のコードの考え方は、空白で仕切られた4つの塊の文字列の2番目が、何であるかを検索しています。 確実に、その場所にあるというなら、 For Each c In rng で、 If Mid(c.Value, 4, 2) = 22 Then とすればよいです。 なお、色は、塗りつぶすなら、Interior の場合は、パステルカラー。Font なら、原色がよいです。 ----------------------------------------------- 'Case のところに、数値と色を加えてください。 Sub TestMacro1() Dim rng As Range Dim c As Range Dim buf As Variant Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants) Application.ScreenUpdating = False rng.Interior.ColorIndex = xlNone For Each c In rng.Cells '全角スペースを半角にする buf = Replace(Trim(c.Value), Space(1), Space(1), , , 1) 'スペースが2個以上入ったものをひとつにする Do While InStr(1, buf, Space(2), 1) > 0 buf = Replace(buf, Space(2), Space(1), , , vbTextCompare) Loop If UBound(Split(buf, Space(1))) > 0 Then buf = Split(buf, Space(1)) '数値を探す(ここに入れる) Select Case Val(buf(1)) Case 22: c.Interior.ColorIndex = 3 '赤(3), ローズ(38)-パステルカラー Case 12: c.Interior.ColorIndex = 5 '青(5), 水色(34)-パステルカラー End Select End If buf = Empty Next c Application.ScreenUpdating = True End Sub
その他の回答 (2)
- fumufumu_2006
- ベストアンサー率66% (163/245)
こんなのではどうでしょうか? データがあるのがSheet1だった場合です。 Sub sample() Dim target As Range Dim r As Range Set target = Sheets("Sheet1").UsedRange For Each r In target If r <> "" Then 'とりあえず、色=自動の戻す r.Font.ColorIndex = xlAutomatic '空白を入れて左から4つめの数字が2、5つめが2のときは赤 If (Mid(r, 4, 1) = "2") And (Mid(r, 5, 1) = "2") Then r.Font.ColorIndex = 3 End If '左から4つめの数字が1、5つめの数字が2のときは青 If (Mid(r, 4, 1) = "1") And (Mid(r, 5, 1) = "2") Then r.Font.ColorIndex = 5 End If '必要に応じて条件を追加 End If Next End Sub
お礼
はじめまして。 ありがとうございます。 こうして書くのですね!! 本当に勉強になります。 これだと、4~5文字目のひとつが変わったときでも 簡単に変えられるのですね。 ありがとうございました。
- nyankonosuke
- ベストアンサー率27% (10/36)
1)現在作っているコードを貼り付けてもらえると、回答しやすいです。 2)質問文だけでは、5つの条件そのものがわからないので、5種類の条件をすべて教えてください。その際に5つの条件の優先順位も教えて下さい。
補足
はじめまして。 1)現在作っているコード↓ Sub Color() Dim c For Each c In Range("A1:E1500") If InStr(c.Value,"12") > 0 Then c.Interior.ColorIndex = 3 End If Next c End sub こんな感じです。 本当に初心者なので、たどたどしいです。 2)5つの条件:すべて同じです。4~5文字目に限定するということ、 順番は特に関係なく、ただただ色分けができればいいというものです。 色も指示されていません。 4~5文字目は、12,22,30,44,60です。
お礼
はじめまして。 ありがとうございます! びっくりしました。すごいです。 空白が一つとは限らないですよね、確かに。 全角を半角にしたり、空白が二つ以上のときにひとつにしたり、 きめ細かい内容で本当に感謝します。 パステルカラーの件も、確かにおっしゃる通りです。 見る人への思いやりですね。 内容はまだまだ初心者の私には、見ても理解できないところがあるのですが、本を見ながら一つずつ理解してみます。 本当に助かりました。 どうもありがとうございました。