Excel VBA質問箱 IV

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

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


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

【61535】特定のセルと一致すれば色を変える チロ 09/5/14(木) 22:40 質問[未読]
【61537】Re:特定のセルと一致すれば色を変える つん 09/5/15(金) 9:55 発言[未読]
【61538】Re:特定のセルと一致すれば色を変える HAM 09/5/15(金) 11:18 発言[未読]
【61540】Re:特定のセルと一致すれば色を変える つん 09/5/15(金) 15:22 発言[未読]
【61546】Re:特定のセルと一致すれば色を変える チロ 09/5/15(金) 20:55 お礼[未読]

【61535】特定のセルと一致すれば色を変える
質問  チロ  - 09/5/14(木) 22:40 -

引用なし
パスワード
   初心者です。。。
特定の場所のセルに名称を入力すると、その下にある一覧表の同じ文字の色を変更したり、セルを塗りつぶしたりしたいのです。
大変困っています。

特定の場所というのは、一覧表の見出し風に作っているセルで、複数あり、空欄にしてあります。
その入力するセルの場所により、一覧の中の一致する文字色を変更したり、セルを塗りつぶすという、下記のようないくつかの作業がしたいのです。

◎ 文字色や塗りつぶしをしたい一覧データはE11〜AH74の範囲にあり、関数の値で 表示されています。
◎ セルの塗りつぶし
  E2のセルに入力した文字と一覧表の関数の値が一致すればセルをピンクに塗り つぶし、F2ではオレンジ、G2は黄色、H2は緑
◎ 文字色の変更
  J2〜L4の12個のセルに入力した文字に一致すれば赤文字
  N2〜Q5の16個のセルに入力した文字に一致すれば青文字

にしたいのです。
 自分なりに調べて、よく分からないのですが、似たようなものを参考に作ったのですが、なんともなりません。

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target '内容を比較
Case ("E2")
Target.Interior.ColorIndex = 7 '塗りつぶしをピンク
Target.Font.ColorIndex = 0 '文字色を黒
Case ("F2")
Target.Interior.ColorIndex = 46 '塗りつぶしをオレンジ
Target.Font.ColorIndex = 0 '文字色を黒
Case ("G2")
Target.Interior.ColorIndex = 6 '塗りつぶしを黄色
Target.Font.ColorIndex = 0 '文字色を黒
Case ("H2")
Target.Interior.ColorIndex = 4 '塗りつぶしを緑色
Target.Font.ColorIndex = 0 '文字色を黒
Case ("J2:L4")
Target.Interior.ColorIndex = xlNone '塗りつぶしを自動
Target.Font.ColorIndex = 3 '文字色を赤
Case ("N2:Q5")
Target.Interior.ColorIndex = xlNone '塗りつぶしを自動
Target.Font.ColorIndex = 5 '文字色を青
End Select
End Sub

 悪いところを修正?(全くダメなのかも。。。)して頂けると助かります。
 それと、VBAが完成した場合、
   シートのタブを右クリックしてコードに貼り付ける
だけでいいのでしょうか?
 VBAの前にタブを入れて頭を下げる
などの事も色々見ましたが、よく分からなかったので、そういった基本的なご指導もして頂きたいのです。

こんなややこしい作業ですが、どうかよろしくお願いします。m(_ _)m

【61537】Re:特定のセルと一致すれば色を変える
発言  つん  - 09/5/15(金) 9:55 -

引用なし
パスワード
   ▼チロ さん
おはようございます^^

私もあまりスキルが高くないので、
最後まで回答できるかわかりませんが、
とりあえず、チロさんのご質問で不明だな・・と思うことを・・・
(私の手に余るようになってきたら、他の先生方が助けてくれると思います^^;)

>◎ 文字色や塗りつぶしをしたい一覧データはE11〜AH74の範囲にあり、関数の値で 表示されています。
>◎ セルの塗りつぶし
>  E2のセルに入力した文字と一覧表の関数の値が一致すればセルをピンクに塗り つぶし、F2ではオレンジ、G2は黄色、H2は緑
>◎ 文字色の変更
>  J2〜L4の12個のセルに入力した文字に一致すれば赤文字
>  N2〜Q5の16個のセルに入力した文字に一致すれば青文字

セルの塗りつぶし、文字色変更の対象範囲は、「E11〜AH74」であって、
入力したセルとは別なんですね?
書かれたコードでは、入力したセル自体に設定してるようですが・・・


>Private Sub Worksheet_Change(ByVal Target As Range)
>Select Case Target '内容を比較
>Case ("E2")
>Target.Interior.ColorIndex = 7 '塗りつぶしをピンク
>Target.Font.ColorIndex = 0 '文字色を黒
>Case ("F2")
>Target.Interior.ColorIndex = 46 '塗りつぶしをオレンジ
>Target.Font.ColorIndex = 0 '文字色を黒
>Case ("G2")
>Target.Interior.ColorIndex = 6 '塗りつぶしを黄色
>Target.Font.ColorIndex = 0 '文字色を黒
>Case ("H2")
>Target.Interior.ColorIndex = 4 '塗りつぶしを緑色
>Target.Font.ColorIndex = 0 '文字色を黒
>Case ("J2:L4")
>Target.Interior.ColorIndex = xlNone '塗りつぶしを自動
>Target.Font.ColorIndex = 3 '文字色を赤
>Case ("N2:Q5")
>Target.Interior.ColorIndex = xlNone '塗りつぶしを自動
>Target.Font.ColorIndex = 5 '文字色を青
>End Select
>End Sub
>
> 悪いところを修正?(全くダメなのかも。。。)して頂けると助かります。

> それと、VBAが完成した場合、
>   シートのタブを右クリックしてコードに貼り付ける
>だけでいいのでしょうか?

これの意味がイマイチわかりませんが・・・・
最初から、ワークシートモジュールに書けばいいんじゃないの?
他のテキストエディタかなんかに書いて、コピペしてるの?


> VBAの前にタブを入れて頭を下げる

VBAの前ってわからないんですが・・・
コードでインデントを入れるんなら、下げたい行を範囲指定して「Tab」で下がります^^

【61538】Re:特定のセルと一致すれば色を変える
発言  HAM  - 09/5/15(金) 11:18 -

引用なし
パスワード
   ▼チロ さん
こんな感じのニュアンスなのでしょうか

  For R1 = 11 To 74
    For C1 = 5 To 34
      With Cells(R1, C1)
        .Interior.ColorIndex = xlNone
        If .Value = Cells(1, 5) Then .Interior.ColorIndex = 7 '塗りつぶしをピンク
        If .Value = Cells(1, 6) Then .Interior.ColorIndex = 46 '塗りつぶしをオレンジ
        If .Value = Cells(1, 7) Then .Interior.ColorIndex = 6 '塗りつぶしを黄色
        If .Value = Cells(1, 8) Then .Interior.ColorIndex = 4 '塗りつぶしを緑色
      End With
      For R2 = 2 To 4
        For C2 = 10 To 12
          If Cells(R1, C1) = Cells(R2, C2) Then Cells(R1, C1).Font.ColorIndex = 3
        Next C2
      Next R2
      For R3 = 2 To 5
        For C3 = 14 To 17
          If Cells(R1, C1) = Cells(R3, C3) Then Cells(R1, C1).Font.ColorIndex = 5
        Next C3
      Next R3
    Next C1
  Next R1

【61540】Re:特定のセルと一致すれば色を変える
発言  つん  - 09/5/15(金) 15:22 -

引用なし
パスワード
   どもども

なんとなく、HAMさんのやり方の方がいいかもな?という気もしますが、
(If .Value = Cells(1, 5) Then .Interior.ColorIndex = 7 '
 ここんとこ  ↑Cells(2,5)ですね^^)

チロさんが、「Worksheet_Change」でしてはったんで、
それでしてみました。

'==============================================
Private Sub Worksheet_Change(ByVal Target As Range)

  Dim r As Range
  Dim r2 As Range
  
  Set r2 = Intersect(Target, Range("e2:h2"))
  'セル色変更入力で重複を防ぐ
    If Not r2 Is Nothing Then
      For Each r In Range("e2:h2")
        If r.Address <> Target.Address And r.Value = Target.Value Then
          MsgBox "値が重複しています"
          Application.EnableEvents = False
          Target.Value = ""
          Application.EnableEvents = True
          Exit Sub
        End If
      Next r
    End If
    
  Set r2 = Intersect(Target, Range("j2:l4", "n2:q5"))
  '文字色変更入力で重複を防ぐ
    If Not r2 Is Nothing Then
      For Each r In Range("j2:l4", "n2:q5")
        If r.Address <> Target.Address And r.Value = Target.Value Then
          MsgBox "値が重複しています"
          Application.EnableEvents = False
          Target.Value = ""
          Application.EnableEvents = True
          Exit Sub
        End If
      Next r
    End If
  
  Select Case Target.Address(0, 0)
    Case "E2"
      Call subIroIro(Target, 7, True)
    Case "F2"
      Call subIroIro(Target, 46, True)
    Case "G2"
      Call subIroIro(Target, 6, True)
    Case "H2"
      Call subIroIro(Target, 4, True)
    Case "J2", "J3", "J4", "K1", "K2", "K3", "L2", "L3", "L4"
      Call subIroIro(Target, 3, False)
    Case "N2", "N3", "N4", "N5", "O2", "O3", "O4", "O5", "P2", "P3", "P4", "P5", "Q2", "Q3", "Q4", "Q5"
      Call subIroIro(Target, 5, False)
  End Select
  
  Set r2 = Nothing
  
End Sub

'==============================================
Sub subIroIro(arg_rTarget As Range, arg_lngIro As Long, arg_blnFlag As Boolean)
'arg_rTarget 入力したセル
'arg_lngIro 設定する色
'arg_blnFlag セル(True)か文字(False)か

  Dim rHit As Range
  Dim strAddress As String
  
  With Range("E11:AH74")
  
    Set rHit = .Find(arg_rTarget.Value, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not rHit Is Nothing Then
      strAddress = rHit.Address
      Do
        Select Case arg_blnFlag
          Case True
            rHit.Interior.ColorIndex = arg_lngIro
          Case False
            rHit.Font.ColorIndex = arg_lngIro
        End Select
        Set rHit = .FindNext(rHit)
      Loop While Not rHit Is Nothing And rHit.Address <> strAddress
    End If
  
  End With

End Sub
'==============================================

一応、セル色変更、文字色変更のくくりで重複しないように処理しましたが、
削除された時とか、他にたくさん問題ありそう^^;

参考にでもなれば^^

【61546】Re:特定のセルと一致すれば色を変える
お礼  チロ  - 09/5/15(金) 20:55 -

引用なし
パスワード
   ▼つんさん&HAMさん
うまく出来ました(^_^;)
色々説明不足ですいませんでした。
会社のデータは持ち出せないし、なかなか会社でする時間がないので、家でネットで勉強したりしていたのですが、基本もなかなか理解出来ず、フラフラになって困っていました。
とても奥が深く、こうして教えて頂かないと出来なかったです。
大変助かりました!
つんさん、HAMさん、ありがとうございましたm(_ _)m

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