Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1200 / 13645 ツリー ←次へ | 前へ→

【75709】シートの値を参照して色をつけたい dai 14/6/18(水) 1:28 質問[未読]
【75712】Re:シートの値を参照して色をつけたい kanabun 14/6/18(水) 10:41 発言[未読]
【75713】Re:シートの値を参照して色をつけたい dai 14/6/18(水) 16:02 お礼[未読]
【75714】Re:シートの値を参照して色をつけたい kanabun 14/6/18(水) 16:36 発言[未読]
【75715】Re:シートの値を参照して色をつけたい dai 14/6/18(水) 16:43 発言[未読]
【75716】Re:シートの値を参照して色をつけたい dai 14/6/18(水) 16:54 発言[未読]
【75717】Re:シートの値を参照して色をつけたい kanabun 14/6/18(水) 17:00 発言[未読]
【75718】Re:シートの値を参照して色をつけたい dai 14/6/18(水) 17:01 お礼[未読]

【75709】シートの値を参照して色をつけたい
質問  dai  - 14/6/18(水) 1:28 -

引用なし
パスワード
   記憶マクロしかできませんどなたか助けてください。
シートの値を参照して別シートのセルに色をつけたいのです。

参照値はシート1にあります。
A列










100行ぐらいあります。

色つけはシート2です。
A列   B列 C列 D列
Aさん  あ  11  さ
Bさん  た  12  は
Cさん  ま  13  か
.
.
.
.
2000行ぐらいあります。

マクロをかけるとシート1のA列を参照して同じだったら
下記のようにしたいです。
A列          B列   C列     D列
Aさん(赤色)   あ(赤色)  11      さ
Bさん       た       12       は
Cさん(赤色)   ま      13       か(赤色)
.
.
.
.
よろしくお願いします。

【75712】Re:シートの値を参照して色をつけたい
発言  kanabun  - 14/6/18(水) 10:41 -

引用なし
パスワード
   ▼dai さん:

>マクロをかけるとシート1のA列を参照して同じだったら
>下記のようにしたいです。
>A列          B列   C列     D列
>Aさん(赤色)   あ(赤色)  11      さ
>Bさん       た       12       は
>Cさん(赤色)   ま      13       か(赤色)

ぼくがやるとすれば、
○○の一つ覚えですがSheet1A列をDictionaryに登録しておき、
Sheet2からはそれを「辞書引き」して何度もLOOKUPしなくて
すむようにします。

'-------------------------------------------- 標準モジュールに
Sub Lookup1()
  Dim dic As Object
  Dim i As Long
  Dim v
  
  '---- Sheet1 A列を辞書にキー登録
  With Worksheets(1)
    v = .Range("A2", .Cells(1).End(xlDown)).Value
  End With
  Set dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(v)
    dic(v(i, 1)) = Empty
  Next
  
  '---- Sheet2のB列またはD列が 辞書にあれば セルを色塗り
  With Worksheets(2)
    .UsedRange.Interior.ColorIndex = xlNone
    v = .Cells(1).CurrentRegion.Columns(2).Resize(, 3).Value
    For i = 1 To UBound(v)
      If dic.Exists(v(i, 1)) Then
        .Cells(i, 1).Interior.Color = vbRed
        .Cells(i, 2).Interior.Color = vbRed
      ElseIf dic.Exists(v(i, 3)) Then
        .Cells(i, 1).Interior.Color = vbRed
        .Cells(i, 4).Interior.Color = vbRed
      End If
    Next
  End With
End Sub

【75713】Re:シートの値を参照して色をつけたい
お礼  dai  - 14/6/18(水) 16:02 -

引用なし
パスワード
   ▼kanabun さん:
対応ありがとうございます。大変助かりました。
もう一つよいでしょうか。
Sheet2のB列またはD列が 辞書にあれば セルを色塗り
をB列からすべての列を対象にできるのしょうか。
たとえばB列〜Z列です。
よろしくお願いします。

【75714】Re:シートの値を参照して色をつけたい
発言  kanabun  - 14/6/18(水) 16:36 -

引用なし
パスワード
   ▼dai さん:

>もう一つよいでしょうか。
>Sheet2のB列またはD列が 辞書にあれば セルを色塗り
>をB列からすべての列を対象にできるのしょうか。
>たとえばB列〜Z列です。

それは、現状 B列とD列だけ辞書チェックしているのを、
B列〜Z列 の列Loopに拡張すればいいだけですけど、
セル塗りつぶしの仕様としては

(1) B列から辞書チェックしていって、たとえば D列にあったら、A列とD列を
  塗りつぶして、後の列のチェックは省略できる

(2) D列にも、M列にも、Z列にも一致データがあることがあるので、
  どんなばあいも、すべての列をチェックしなければならない。

(1),(2) どちらでしょう?

【75715】Re:シートの値を参照して色をつけたい
発言  dai  - 14/6/18(水) 16:43 -

引用なし
パスワード
   ▼kanabun さん:
返信ありがとうございます。
(2)です。
>(2) D列にも、M列にも、Z列にも一致データがあることがあるので、
>  どんなばあいも、すべての列をチェックしなければならない。
毎月のデータをじっくり見たところ
列が不変でA列〜Z列の時もあればA列〜AL列の時もありました。
どこの列に値が入ってくるのかわからいのです。
よろしくお願いします。

【75716】Re:シートの値を参照して色をつけたい
発言  dai  - 14/6/18(水) 16:54 -

引用なし
パスワード
   ▼kanabun さん:
度々すいません。
すべてのデータをチェックしたところ
MaxはAL列まででした。
A列の氏名は固定です。
B列からすべて列をチェックしたいです。
よろしくお願いします。

【75717】Re:シートの値を参照して色をつけたい
発言  kanabun  - 14/6/18(水) 17:00 -

引用なし
パスワード
   ▼dai さん:

>MaxはAL列まででした。
>A列の氏名は固定です。
>B列からすべて列をチェックしたいです。

列数が変動する場合です

Sub Lookup3()
  Dim dic As Object
  Dim i As Long, j As Long, jz As Long
  Dim ok As Boolean
  Dim v
  
  '---- Sheet1 A列を辞書にキー登録
  With Worksheets(1)
    v = .Range("A2", .Cells(1).End(xlDown)).Value
  End With
  Set dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(v)
    dic(v(i, 1)) = Empty
  Next
  
  '---- Sheet2のB列またはD列が 辞書にあれば セルを色塗り
  With Worksheets(2)
    .UsedRange.Interior.ColorIndex = xlNone
    v = .Cells(1).CurrentRegion.Value
    jz = UBound(v, 2)   '最終列番号
    For i = 2 To UBound(v) '2行目から
      ok = False
      For j = 2 To jz 'B列からチェックはじめ
       If dic.Exists(v(i, j)) Then
        If Not ok Then
          .Cells(i, 1).Interior.Color = vbRed 'A列
          ok = True
        End If
        .Cells(i, j).Interior.Color = vbRed
       End If
      Next
    Next
  End With
End Sub

【75718】Re:シートの値を参照して色をつけたい
お礼  dai  - 14/6/18(水) 17:01 -

引用なし
パスワード
   ▼kanabun さん:
早々の対応ありがとうございます。
うまくいきました。本当に感謝です。

1200 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free