Excel VBA質問箱 IV

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

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


9430 / 13644 ツリー ←次へ | 前へ→

【27343】条件によるセル色の変更について ヒライ 05/8/5(金) 20:26 質問[未読]
【27359】Re:条件によるセル色の変更について りん 05/8/6(土) 13:44 回答[未読]
【27360】Re:条件によるセル色の変更について ヒライ 05/8/6(土) 14:01 質問[未読]
【27362】Re:条件によるセル色の変更について かみちゃん 05/8/6(土) 14:06 回答[未読]
【27363】Re:条件によるセル色の変更について ヒライ 05/8/6(土) 14:27 お礼[未読]
【27374】Re:条件によるセル色の変更について りん 05/8/7(日) 12:05 発言[未読]
【27367】Re:条件によるセル色の変更について yasu 05/8/6(土) 16:15 回答[未読]
【27368】Re:条件によるセル色の変更について かみちゃん 05/8/6(土) 16:22 回答[未読]
【27371】Re:条件によるセル色の変更について りん 05/8/6(土) 20:18 発言[未読]
【27372】Re:条件によるセル色の変更について yasu 05/8/7(日) 6:57 質問[未読]
【27373】Re:条件によるセル色の変更について かみちゃん 05/8/7(日) 7:20 発言[未読]
【27375】Re:条件によるセル色の変更について りん 05/8/7(日) 12:13 発言[未読]
【27378】Re:条件によるセル色の変更について yasu 05/8/7(日) 18:02 質問[未読]
【27393】Re:条件によるセル色の変更について りん 05/8/8(月) 9:00 回答[未読]
【27417】Re:条件によるセル色の変更について yasu 05/8/8(月) 19:12 お礼[未読]

【27343】条件によるセル色の変更について
質問  ヒライ  - 05/8/5(金) 20:26 -

引用なし
パスワード
   何卒、ご教授宜しくお願いいたします。

下記のフォーマットを利用しています。
日付の下に値を入れるのですがJ、K、L列の範囲を超えた場合にセルに色を付けたく思います。

100<150 →値が100より大きく150より小さい時は真、そうでなければ偽(色を付ける) 
100<  →値が100より大きければ真、そうでなければ偽(色を付ける)
という具合で
下記にマクロを実行しましたが
100 <
120 ≦
のようにL列が空欄の場合に旨く動作しません。

何方かご指摘をお願いいたします

  A  B C・・ J  K  L・・・Z  AA  AB AC
1 

・ 
9 No         範囲     7/1 7/2 7/3 7/4・・
11 101      100 < 150         
12 102      100 <
13 103         < 150
14 104      120 ≦ 
15 105      80  ≦ 100
16 106         ≦ 120
17 107      150 〜 160





700


Private Sub Worksheet_Change(ByVal Target As Range)
 Dim lngCol As Long
 Dim lngRow As Long
 Dim lngR As Range


 With Target
 If .Count > 1 Then Exit Sub
 If IsEmpty(.Value) Then Exit Sub
 If IsNumeric(.Value) = False Then Exit Sub
  
 lngCol = Cells(10, 256).End(xlToLeft).Column
 lngRow = Cells(Rows.Count, 26).End(xlUp).Row
 Set lngR = Range(Cells(10, 26), Cells(lngRow, lngCol))
 
 
 If Not Application.Intersect(Target, lngR) Is Nothing Then
  Application.EnableEvents = False
  .Interior.ColorIndex = xlNone
  
   Select Case Cells(.Row, 11).Value
   Case Is = "<"
  If Cells(.Row, 12) = "" And .Value <= Cells(.Row, 10).Value Then
      .Interior.ColorIndex = 8
        Else
     .Interior.ColorIndex = xlNone
      End If
 If Cells(.Row, 10) = "" And .Value >= Cells(.Row, 12).Value Then
      .Interior.ColorIndex = 8
        Else
     .Interior.ColorIndex = xlNone
      End If

   If .Value <= Cells(.Row, 10).Value Or .Value >= Cells(.Row, 12).Value Then
     .Interior.ColorIndex = 8
   Else
     .Interior.ColorIndex = xlNone
   End If
   
     Case Is = "≦"
      If Cells(.Row, 10) = "" And .Value > Cells(.Row, 12).Value Then
      .Interior.ColorIndex = 8
        Else
     .Interior.ColorIndex = xlNone
      End If
 If Cells(.Row, 12) = "" And .Value < Cells(.Row, 10).Value Then
      .Interior.ColorIndex = 8
        Else
     .Interior.ColorIndex = xlNone
      End If
    
   If .Value < Cells(.Row, 10).Value Or .Value > Cells(.Row, 12).Value Then
     .Interior.ColorIndex = 8
   Else
     .Interior.ColorIndex = xlNone
   End If
   
   Case Is = "〜"
        If Cells(.Row, 10) = "" And .Value > Cells(.Row, 12).Value Then
      .Interior.ColorIndex = 8
      End If
 If Cells(.Row, 12) = "" And .Value < Cells(.Row, 10).Value Then
      .Interior.ColorIndex = 8
      End If
   If .Value < Cells(.Row, 10).Value Or .Value > Cells(.Row, 12).Value Then
     .Interior.ColorIndex = 8
   Else
     .Interior.ColorIndex = xlNone
   End If
   Case Else
     .Interior.ColorIndex = xlNone
  
   End Select
    
  End If
Application.EnableEvents = True

End With


End Sub

【27359】Re:条件によるセル色の変更について
回答  りん E-MAIL  - 05/8/6(土) 13:44 -

引用なし
パスワード
   ヒライ さん、こんにちわ。

>例
>100<150 →値が100より大きく150より小さい時は真、そうでなければ偽(色を付ける) 
>100<  →値が100より大きければ真、そうでなければ偽(色を付ける)
>という具合で

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim lngCol As Long
  Dim lngRow As Long
  Dim Cflg As Boolean
  '
  Application.EnableEvents = False
  '
  lngCol = Cells(10, 256).End(xlToLeft).Column
  lngRow = Cells(Rows.Count, 26).End(xlUp).Row
  With Target
   If .Count = 1 Then
     If Not IsEmpty(.Value) Then
      If IsNumeric(.Value) Then
        If (.Row >= 10 And .Row <= lngRow) And (.Column >= 26 And .Column >= lngCol) Then
         MsgBox Cells(.Row, 11).Address
         Select Case Cells(.Row, 11).Value
           Case "<"
            '両方入っていないものは考慮にいれてありません
            If Cells(.Row, 10).Value = "" Then
              'X<
              Cflg = .Value < Cells(.Row, 12).Value
            Else
              '<X
              Cflg = Cells(.Row, 10).Value < .Value
              '<X<
              If Cells(.Row, 12).Value <> "" Then _
               Cflg = Cflg And (.Value < Cells(.Row, 12).Value)
            End If
           Case "≦", "〜"
            '"〜"と"≦"との違いがわからないので統合。
            '両方入っていないものは考慮にいれてありません
            MsgBox Cells(.Row, 10).Value
            If Cells(.Row, 10).Value = "" Then
              'X<=
              Cflg = .Value <= Cells(.Row, 12).Value
            Else
              '<=X
              Cflg = Cells(.Row, 10).Value <= .Value
              '<=X<=
              If Cells(.Row, 12).Value <> "" Then _
               Cflg = Cflg And (.Value <= Cells(.Row, 12).Value)
            End If
           Case Else
            Cflg = False
         End Select
         'ここで色を変化させる
         Select Case Cflg
           Case True: .Interior.ColorIndex = 8 '条件に適応
           Case False: .Interior.ColorIndex = xlNone
         End Select
        End If
      End If
     End If
   End If
  End With
Application.EnableEvents = True
End Sub

こんな感じです。

【27360】Re:条件によるセル色の変更について
質問  ヒライ  - 05/8/6(土) 14:01 -

引用なし
パスワード
   りん さん 有難うございます。

質問があるのですが
値を入力する度にmsgbox"$k$11"、msgbox"$k$12"などが次々と表示されます。

表示を無くそうと思いますが
これは何処で設定しているのでしょうか?

【27362】Re:条件によるセル色の変更について
回答  かみちゃん  - 05/8/6(土) 14:06 -

引用なし
パスワード
   こんにちは。かみちゃん です。

りんさん、横から失礼します。

>値を入力する度にmsgbox"$k$11"、msgbox"$k$12"などが次々と表示されます。
>
>表示を無くそうと思いますが

MsgBox 〜と記述されているコードを探してみてください。

If (.Row >= 10 And .Row <= lngRow) And (.Column >= 26 And .Column >= lngCol) Then
 MsgBox Cells(.Row, 11).Address '★
 Select Case Cells(.Row, 11).Value

〜省略〜

  Case "≦", "〜"
   '"〜"と"≦"との違いがわからないので統合。
   '両方入っていないものは考慮にいれてありません
   MsgBox Cells(.Row, 10).Value '★

【27363】Re:条件によるセル色の変更について
お礼  ヒライ  - 05/8/6(土) 14:27 -

引用なし
パスワード
   りんさん、かみちゃんさん

感謝です。
MsgBox、気がつきませんでした。
削除したら動作しました。
お手数をお掛けしました。

【27367】Re:条件によるセル色の変更について
回答  yasu  - 05/8/6(土) 16:15 -

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

お邪魔します。すみません。
Case True: .Interior.ColorIndex = 8 '条件に適応
のカラー指定はどの列に表示されるのでしょうか?

Msgの表示は分かるんですが・・・

【27368】Re:条件によるセル色の変更について
回答  かみちゃん  - 05/8/6(土) 16:22 -

引用なし
パスワード
   yasu さん、こんにちは。かみちゃん です。

りんさん、またまた横から失礼します。

>Case True: .Interior.ColorIndex = 8 '条件に適応
>のカラー指定はどの列に表示されるのでしょうか?

以下の★です。
ここのTargetというのは、
Worksheet_Change(ByVal Target As Range)
で指定されているので、セルの値を変更したときのそのセルの列ということになる
のではないでしょうか?

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim lngCol As Long
  Dim lngRow As Long
  Dim Cflg As Boolean
  '
  Application.EnableEvents = False
  '
  lngCol = Cells(10, 256).End(xlToLeft).Column
  lngRow = Cells(Rows.Count, 26).End(xlUp).Row
  With Target '★

【27371】Re:条件によるセル色の変更について
発言  りん E-MAIL  - 05/8/6(土) 20:18 -

引用なし
パスワード
   みなさん、こんばんわ。

>>Case True: .Interior.ColorIndex = 8 '条件に適応
>>のカラー指定はどの列に表示されるのでしょうか?
>ここのTargetというのは、
>Worksheet_Change(ByVal Target As Range)
>で指定されているので、セルの値を変更したときのそのセルの列ということになる
>のではないでしょうか?
補足ですが、
 Changeイベントが起きた対象のセル範囲(Target)が、
  ・単一セルである
  ・Z列以降である
  ・11行目以降である
を満たし、かつ、
 値が入っており、その値が数値である場合
に、数値範囲の条件をチェックします(ここまではもとのまま)。

そして、上記のチェックで範囲内の場合はTrue、範囲外の場合はFalseとなるので、
最後にTargetに書式を設定しています。

メッセージボックスは、デバッグのために入れて、そのままはずすのを忘れていました。ややこしい事をしてごめんなさい。

かみちゃん さん、色々ありがとうございました。これからもよろしくお願いします。

【27372】Re:条件によるセル色の変更について
質問  yasu  - 05/8/7(日) 6:57 -

引用なし
パスワード
   ▼りん さん かみちゃん さん:

おはようございます。

よこから質問しまして失礼しました。興味がありましたので拝見させて頂いていました。
そして、りんさんの解説ありがとうございます。
よく理解できました。
何が災いしているのか、対象セル範囲(Target)に数値を入れても、True Falseの反応が出てこないのですが・・・何か問題があるのか?っと思い質問させていただいた次第です。皆様の方では、問題なくリアクション(Case True: .Interior.ColorIndex = 8)があるのでしょうか?
極端な数字0や1000などの数字と不等号に合致する数字を入力していますが、色変化が適合しませんが、何か条件があるのでしょうか。

【27373】Re:条件によるセル色の変更について
発言  かみちゃん  - 05/8/7(日) 7:20 -

引用なし
パスワード
   yasu さん、こんにちは。かみちゃん です。

>何が災いしているのか、対象セル範囲(Target)に数値を入れても、True Falseの反応が出てこない

非常に抽象的な回答で申し訳ないですが、経験談です。

たぶん、
Application.EnableEvents = False
このコードを使うとき、コードの途中でエラー終了してしまった場合、それ以降
反応がなくなることはあるようです。私は、経験したことがしばしばあります。
そのとき、私は、いつもExcelブックを再起動しています。そうすると、正常に
動くようになることが多いです。

なお、それでもだめな場合、どのシートのどのセルにどういう値を入れているのか
具体的に教えてください。

【27374】Re:条件によるセル色の変更について
発言  りん E-MAIL  - 05/8/7(日) 12:05 -

引用なし
パスワード
   ヒライ さん、解決後ですが。

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Cflg As Boolean
  Application.EnableEvents = False
  '
  With Target
   If .Count = 1 Then
     If Not IsEmpty(.Value) Then
      If IsNumeric(.Value) Then
        If .Row >= 10 And .Column >= 26 Then
<<<<以下略>>>>

セルZ10から、右、下であればよいようなので、右端/下端の判定はいらないようです。

【27375】Re:条件によるセル色の変更について
発言  りん E-MAIL  - 05/8/7(日) 12:13 -

引用なし
パスワード
   みなさん、こんにちわ。

>>>Case True: .Interior.ColorIndex = 8 '条件に適応
>>>のカラー指定はどの列に表示されるのでしょうか?
>>ここのTargetというのは、
>>Worksheet_Change(ByVal Target As Range)
>>で指定されているので、セルの値を変更したときのそのセルの列ということになる
>>のではないでしょうか?
>補足ですが、
> Changeイベントが起きた対象のセル範囲(Target)が、
>  ・単一セルである
>  ・Z列以降である
>  ・11行目以降である
10行目でした。

>を満たし、かつ、
> 値が入っており、その値が数値である場合
>に、数値範囲の条件をチェックします(ここまではもとのまま)。

前回貼ったコードを試して、Z10より、右、下セルに数値を入れたときにメッセージボックスが出なければ、イベントはおきていません。
考えられる理由として、
 ・EnableEvents=Falseになっている
 ・イベントを貼り付けたシートが違う
 ・値を入力したセルが10行目より上(条件に合っていない)
 ・   〃     Z列より左  (    〃    )

イベント実行の状態をチェックして、起きない場合は起こるようにする。
Sub Test()
  With Application
   Select Case .EnableEvents
     Case True: MsgBox .EnableEvents, vbInformation
     Case False
      MsgBox .EnableEvents, vbExclamation
      .EnableEvents = True 'おきる
   End Select
  End With
End Sub

【27378】Re:条件によるセル色の変更について
質問  yasu  - 05/8/7(日) 18:02 -

引用なし
パスワード
   ▼りん さん かみちゃんさん:

色々とアドバイスありがとうございます。
現状をお伝えしますと、シートの入力の状態は・・・


    Z    AA    AB   AC
9  7月1日  7月2日  7月3日 7月4日 

11   0    140    150   160
12
13
14
15
16
17              ☆   ☆

☆:No.8のインテリアカラー

11行から17行まで 11行の数字を全て打ち込むと

7月1日の列無反応・・・Z列
11行目に数字を入れた時には、$K$11の絶対参照がなされています。
17行目まで同じく、$K$17のセルの参照をしています。

同じように
7月2日も無反応・・・AA列
MsgBoxには同じく 参照セルが同じようにK列で実行できています。

7月3日・・・AB列
7月4日・・・AC列
共に17行目のセルにNo.8の色が出ます。
MsgBoxは共に同じ動作をしています。


>前回貼ったコードを試して、Z10より、右、下セルに数値を入れたときにメッセージボックスが出なければ、イベントはおきていません。
これはOKです。

>考えられる理由として、
> ・EnableEvents=Falseになっている
> ・イベントを貼り付けたシートが違う
> ・値を入力したセルが10行目より上(条件に合っていない)
> ・   〃     Z列より左  (    〃    )
上記4点も確認済みですが。

不等号の「範囲」は
以下の配列で問題ないですよね。

J列    K列    L列
100    <    150
100    <
(空き)  <    150
120    <= 
80     <=   100 
(空き)   <=   120
150    〜    160

何か問題が有りましたら、ご指摘ください。
ありがとうございます。

【27393】Re:条件によるセル色の変更について
回答  りん E-MAIL  - 05/8/8(月) 9:00 -

引用なし
パスワード
   yasu さん、おはようございます。

再現できるといいですが。

【準備】
↓ここから==============
1行目,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
2行目,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
3行目,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
4行目,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
5行目,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
6行目,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
7行目,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
8行目,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
9行目,,,,,,,,,,範囲,,,,,,,,,,,,,,,7月1日,7月2日,7月3日,7月4日,7月5日
10行目,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
11行目,,,,,,,,,10,≦,100,,,,,,,,,,,,,,,,,,
12行目,,,,,,,,,10,<,100,,,,,,,,,,,,,,,,,,
13行目,,,,,,,,,10,〜,100,,,,,,,,,,,,,,,,,,
14行目,,,,,,,,,10,<,,,,,,,,,,,,,,,,,,,
15行目,,,,,,,,,,<,100,,,,,,,,,,,,,,,,,,
↑ここまで==============
上の15行をコピー
エクセルのA1セルにペースト(15行目がA15に入るように)
メニューバーの、データ → 区切り位置 → カンマやタブ
カンマにチェックをつけて実行すると、Z9に7月1日が入ります。

そのシートに、以下のイベントを記述
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Cflg As Boolean
  Application.EnableEvents = False
  '
  With Target
   If .Count = 1 Then
     If Not IsEmpty(.Value) Then
      If IsNumeric(.Value) Then
        If .Row >= 10 And .Column >= 26 Then
         Select Case Cells(.Row, 11).Value
           Case "<"
            '両方入っていないものは考慮にいれてありません
            If Cells(.Row, 10).Value = "" Then
              'X<
              Cflg = .Value < Cells(.Row, 12).Value
            Else
              '<X
              Cflg = Cells(.Row, 10).Value < .Value
              '<X<
              If Cells(.Row, 12).Value <> "" Then _
               Cflg = Cflg And (.Value < Cells(.Row, 12).Value)
            End If
           Case "≦", "〜"
            '"〜"と"≦"との違いがわからないので統合。
            '両方入っていないものは考慮にいれてありません
            If Cells(.Row, 10).Value = "" Then
              'X<=
              Cflg = .Value <= Cells(.Row, 12).Value
            Else
              '<=X
              Cflg = Cells(.Row, 10).Value <= .Value
              '<=X<=
              If Cells(.Row, 12).Value <> "" Then _
               Cflg = Cflg And (.Value <= Cells(.Row, 12).Value)
            End If
           Case Else
            Cflg = False
         End Select
         'ここで色を変化させる
         Select Case Cflg
           Case True: .Interior.ColorIndex = 8 '条件に適応:水色
           Case False: .Interior.ColorIndex = xlNone
         End Select
        End If
      End If
     End If
   Else
     .Interior.ColorIndex = xlNone '追加:まとめて選んだときは色消去
   End If
  End With
  Application.EnableEvents = True
End Sub

これでうまくいきました。

【27417】Re:条件によるセル色の変更について
お礼  yasu  - 05/8/8(月) 19:12 -

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

大変お手数をかけました。
よく理解できました。
素晴らしいこのコードはまた、必ずや活用できると信じて、何度もお聞きしてお手数を煩わしました。ご迷惑をかけました。
(また、今回改めて、コードを書き直していただき感謝しています。ありがとうございました。)

レイアウトも全て間違いなく、出来ていましたが・・・
恥ずかしい事ですが、11列目ですが、不等号が文字列ではなく、本来の不等号を入力していました。
解決しました。
今日も何が災いしているのか、気持ちが悪く・・・会社でコードをじっくり見させていただき、問題点は何か?探していました、ここが問題であることが分かりました。
このコードを見て気づきました。⇒ Case "<"

<→<  ≦→<= にして表の作成をしていました。ですから”〜”の部分だけは正常に動作していたのです。お恥ずかしい限りです。

本当にご迷惑をかけました。
ありがとうございました。今後ともよろしくお願いします。

かみちゃんさん、お世話になりました。

では失礼します。

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