はじめまして。マクロ初心者です。
よろしくお願いいたします。
エクセルに入力されている数値によってセルを色分けしたいのです。
数値はこんなふうに入力されています↓
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日も悩んでいますが、どうにも手も足も出ません。
ご指導いただけると本当に助かります。
どうぞよろしくお願いいたします。
No.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
はじめまして。
ありがとうございます!
びっくりしました。すごいです。
空白が一つとは限らないですよね、確かに。
全角を半角にしたり、空白が二つ以上のときにひとつにしたり、
きめ細かい内容で本当に感謝します。
パステルカラーの件も、確かにおっしゃる通りです。
見る人への思いやりですね。
内容はまだまだ初心者の私には、見ても理解できないところがあるのですが、本を見ながら一つずつ理解してみます。
本当に助かりました。
どうもありがとうございました。
No.2
- 回答日時:
こんなのではどうでしょうか?
データがあるのが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文字目のひとつが変わったときでも
簡単に変えられるのですね。
ありがとうございました。
No.1
- 回答日時:
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です。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
- ・ゆるやかでぃべーと タイムマシンを破壊すべきか。
- ・歩いた自慢大会
- ・許せない心理テスト
- ・字面がカッコいい英単語
- ・これ何て呼びますか Part2
- ・人生で一番思い出に残ってる靴
- ・ゆるやかでぃべーと すべての高校生はアルバイトをするべきだ。
- ・初めて自分の家と他人の家が違う、と意識した時
- ・単二電池
- ・チョコミントアイス
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
IF関数で空欄("")の時、Null...
-
数式による空白を無視して最終...
-
Excelで、入力文字の後に自動で...
-
ピボットテーブルで空白セルの...
-
エクセルで上の行の値を自動的...
-
Excel > ピボットテーブル「(空...
-
「データ要素を線で結ぶ」がチ...
-
エクセルでCSVを編集するとき、...
-
エクセル 連番が途切れていると...
-
空白セルにハイフンを表示
-
Excel:関数が入っているセルに...
-
VBA スペースが入力されて...
-
形式貼り付けの「空白を無視す...
-
関数TRANSPOSEで空白セルを0に...
-
excel2010 空白セルにのみ貼り...
-
色つき行の一括削除は?
-
空白セル内の数式を残したまま...
-
SUMIFS関数で「計算式による空...
-
【Excel】 Ctrl+方向キー で空...
-
エクセル VLOOKUP関数 日付は日...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
IF関数で空欄("")の時、Null...
-
エクセルでCSVを編集するとき、...
-
数式による空白を無視して最終...
-
「データ要素を線で結ぶ」がチ...
-
Excel > ピボットテーブル「(空...
-
関数TRANSPOSEで空白セルを0に...
-
ピボットテーブルで空白セルの...
-
空白セル内の数式を残したまま...
-
【Excel】 csvの作成時、空白セ...
-
色つき行の一括削除は?
-
excel2010 空白セルにのみ貼り...
-
エクセルで上の行の値を自動的...
-
Excel:関数が入っているセルに...
-
Excelで、入力文字の後に自動で...
-
エクセル 連番が途切れていると...
-
SUMIFS関数で「計算式による空...
-
【Excel】 Ctrl+方向キー で空...
-
《Excel2000》SUMPRODUCT関数で...
-
形式貼り付けの「空白を無視す...
-
エクセル VLOOKUP関数 日付は日...
おすすめ情報