人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

【エクセルVBA】セル内の色を読み取って同じ数値のところに同じ色を塗りつけたい。



詳しくは画像をご確認ください。
KLM列にある数値や英文字の並びを読み取り、A,C,E,G,I,K,L,M列内の同数値に同じ色を塗りつけるマクロをお願いします。


【注意点】
・エクセルは条件付き書式の使えないバージョンでもできるマクロとします。(1997-2003)
・A,C,E,G,I,K,L,M列にはいる数値、英文字は3行までではなく、もっと続きます。
・K,L,M列内には同じ数値が入る場合があります。その場合は処理した順に塗りつぶすこととし、エラーは出さないでください。
・どの列でも、列は、空白が2行続いた時点で読み取りを終了します。(A,C,E,G,I,K,L,M列)
・K-Lまでは列内の色は様々なものとします。
・該当しない場合は何もしません。

恐れ入りますが、マクロ以外のご回答にポイントはおつけできません。
よろしくお願いいたします。

1451251947
●拡大する


●質問者: naranara19
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● a-kuma3
●250ポイント ベストアンサー

以下のコードを標準モジュールに貼り付けて、set_background_color サブルーチンを実行してください。
アクティブなシートを対象にして、背景色の設定を行います。

Const MAX_ROW = 10000  ' 処理対象の最大行数

Function is_blank_cell(c)
 is_blank_cell = IsEmpty(c) Or c.Value = ""
End Function

Sub set_background_color()
 Dim bgcolor_map
 Set bgcolor_map = CreateObject("Scripting.Dictionary")

  ' K?M 列の背景色を読み取る
 For c = 11 To 13  ' K - M
 r = 1
 Do Until is_blank_cell(Cells(r, c))
 v = Cells(r, c).Value
 bgcolor = Cells(r, c).Interior.Color
  ' 重複した場合は、先勝ち
 If Not bgcolor_map.Exists(v) Then
 bgcolor_map.Add v, bgcolor
 End If
 DoEvents
 r = r + 1
 If r > MAX_ROW Then  ' 念のため
 Exit Do
 End If
 Loop
 Next

  ' A, C, E, G, I 列に背景色を設定する
 For c = 1 To 9 Step 2  ' A, C, E, G, I
 r = 1
 is_prev_blank = False
 Do Until is_prev_blank And is_blank_cell(Cells(r, c))
 v = Cells(r, c).Value
 If bgcolor_map.Exists(v) Then
 Cells(r, c).Interior.Color = bgcolor_map.Item(v)
 End If
 is_prev_blank = is_blank_cell(Cells(r, c))
 DoEvents
 r = r + 1
 If r > MAX_ROW Then  ' 念のため
 Exit Do
 End If
 Loop
 Next
End Sub

K、L、M 列の背景色を A、C、E、G、I 列に設定するように作ってあります。
質問では、「A、C、E、G、I、K、L、M 列に……」とありますが、K、L、M 列で値が重複した場合に妙な感じになると思うので。

行方向の終了条件には、無限ループが恐いので最大の行数も指定してあります。

・K,L,M列内には同じ数値が入る場合があります。その場合は処理した順に塗りつぶすこととし、エラーは出さないでください。

値が重複した場合には、先勝ちにしました。
後勝ちにしたければ、以下の部分を

  ' 重複した場合は、先勝ち
 If Not bgcolor_map.Exists(v) Then
 bgcolor_map.Add v, bgcolor
 End If

以下のコードに置き換えてください。

  ' 重複した場合は、後勝ち
 If bgcolor_map.Exists(v) Then
 bgcolor_map.Remove v
 End If
 bgcolor_map.Add v, bgcolor

naranara19さんのコメント
いつも完璧にご配慮いただき、大変感謝しております!本当にありがとうございます。
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ