Excel VBA質問箱 IV

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

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


54139 / 76732 ←次へ | 前へ→

【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

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

2 hits

【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 お礼

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