Excel VBA質問箱 IV

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

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


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

【45268】VBAを使った4つ以上の条件付き書式 ジジ 06/12/17(日) 8:36 質問[未読]
【45269】Re:VBAを使った4つ以上の条件付き書式 ponpon 06/12/17(日) 12:21 発言[未読]
【45270】Re:VBAを使った4つ以上の条件付き書式 ジジ 06/12/17(日) 12:41 質問[未読]
【45272】Re:VBAを使った4つ以上の条件付き書式 ponpon 06/12/17(日) 13:54 発言[未読]
【45274】Re:VBAを使った4つ以上の条件付き書式 ジジ 06/12/17(日) 19:54 お礼[未読]
【45277】Re:VBAを使った4つ以上の条件付き書式 ジジ 06/12/17(日) 23:54 質問[未読]
【45281】Re:VBAを使った4つ以上の条件付き書式 Kein 06/12/18(月) 2:54 回答[未読]
【45312】Re:VBAを使った4つ以上の条件付き書式 ジジ 06/12/18(月) 22:44 お礼[未読]

【45268】VBAを使った4つ以上の条件付き書式
質問  ジジ  - 06/12/17(日) 8:36 -

引用なし
パスワード
   シート内のF列からZ列内を対象に
「1」から始まる値を含むセルの背景を黄色に
「2」から始まる値を含むセルの背景を緑色に
「3」から始まる値を含むセルの背景を水色に
「4」から始まる値を含むセルの背景を赤色に
するVBAはどんなコードにすればいいのでしょうか。

値はこれから入力するもので、随時変更もします。
また、コピーして入力されることもあります。
これらにも対応して背景色を変化させたいです。

よろしくお願いします。

【45269】Re:VBAを使った4つ以上の条件付き書式
発言  ponpon  - 06/12/17(日) 12:21 -

引用なし
パスワード
   ▼ジジ さん:
>シート内のF列からZ列内を対象に
>「1」から始まる値を含むセルの背景を黄色に
>「2」から始まる値を含むセルの背景を緑色に
>「3」から始まる値を含むセルの背景を水色に
>「4」から始まる値を含むセルの背景を赤色に
>するVBAはどんなコードにすればいいのでしょうか。
>
>値はこれから入力するもので、随時変更もします。

>また、コピーして入力されることもあります。
>これらにも対応して背景色を変化させたいです。

おはようございます。
複数貼り付けられることもあるのでしょうか?
こんな感じになると思います。

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim myNO As Long
  Dim r As Range
  
    If Application.Intersect(Target, Range("F:Z")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Each r In Target
      If IsNumeric(r.Value) Then
       Select Case Left$(CStr(r.Value), 1)
         Case "1": myNO = 6
         Case "2": myNO = 4
         Case "3": myNO = 8
         Case "4": myNO = 3
       End Select
      r.Interior.ColorIndex = myNO
      Else
      r.Interior.ColorIndex = xlNone
      End If
    Next
    Application.EnableEvents = True
End Sub

【45270】Re:VBAを使った4つ以上の条件付き書式
質問  ジジ  - 06/12/17(日) 12:41 -

引用なし
パスワード
   ponponさんありがとうございます。
確かに希望通りになりました。
ただ、「1」から始まる値なので「1テスト」でも黄色になるようにしたいので、
Case "1*": myNO = 6
に変更してみたら効かなくなってしまいました。
どう変更すればいいのでしょう?

また、列の範囲はZ列までとしましたが、さらに増えるかもしれません。
その場合、
If Application.Intersect(Target, Range("F:AZ")) Is Nothing Then Exit Sub
のようにすればいいのでしょうか?

【45272】Re:VBAを使った4つ以上の条件付き書式
発言  ponpon  - 06/12/17(日) 13:54 -

引用なし
パスワード
   ▼ジジ さん:
>ただ、「1」から始まる値なので「1テスト」でも黄色になるようにしたいので、

どのような値が入るのかよくわかりませんので、変化する値を
限定できませんが、

以下のように変えてみてください。
  '・・・・・・
  Dim myVal
    '・・・・・・
    For Each r In Target
      If Not IsEmpty(r.Value) Then
       myVal = Left$(r.Value, 1)
       Select Case myVal
         Case 1: myNO = 6
         Case 2: myNO = 4
         Case 3: myNO = 8
         Case 4: myNO = 3
         Case Else: myNO = xlNone
       End Select
       r.Interior.ColorIndex = myNO
      End If
    Next
    '・・・・・・


>また、列の範囲はZ列までとしましたが、さらに増えるかもしれません。
>その場合、
>If Application.Intersect(Target, Range("F:AZ")) Is Nothing Then Exit Sub
>のようにすればいいのでしょうか?

そうです。

【45274】Re:VBAを使った4つ以上の条件付き書式
お礼  ジジ  - 06/12/17(日) 19:54 -

引用なし
パスワード
   これでよろしいのでしょうか

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim myNO As Long
  Dim r As Range
  Dim myVal
 
    If Application.Intersect(Target, Range("G:Z")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Each r In Target
      If Not IsEmpty(r.Value) Then
       myVal = Left$(r.Value, 1)
       Select Case myVal
         Case 1: myNO = 6
         Case 2: myNO = 4
         Case 3: myNO = 8
         Case 4: myNO = 3
         Case Else: myNO = xlNone
       End Select
       r.Interior.ColorIndex = myNO
      End If
    Next
    Application.EnableEvents = True
End Sub

【45277】Re:VBAを使った4つ以上の条件付き書式
質問  ジジ  - 06/12/17(日) 23:54 -

引用なし
パスワード
   一応色は付きました。
あとはセルの値を削除したときに色も削除したいです。
また、E列には各行の1で始まる値を持つセル(=黄色に染まったセル)の数を返したいのですがどうすればよいのでしょうか。
例えば、F1に「1試験」、G1に「1チェック」、H1に「1」と入力したとき、E1には「3」という数字を返せるようにしたいです。

【45281】Re:VBAを使った4つ以上の条件付き書式
回答  Kein  - 06/12/18(月) 2:54 -

引用なし
パスワード
   >E列には各行の1で始まる値を持つセル(=黄色に染まったセル)の数を返したい
これは簡単なようにみえて、結構ややこしいロジックになります。
なぜなら追加は単純に +1 すればいいのだけど、クリアしたときに元の値の先頭
の文字が 1 だったかどうかを判定しないと、正しくマイナスすることが
出来ないからです。そのためにはクリアのときだけ Undo して、いったん元の値を
復活させるという方法も考えられますが、今回は "全て清算してから数え直す"
というやり方にしてみました。

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim TgR As Long, myNO As Long
  Dim GetV As Variant
  Dim r As Range, rb As Range, MyR As Range

  With Target
   If .Column < 6 Then Exit Sub
   TgR = .Row
  End With
  Application.EnableEvents = False
  For Each r In Target
   myNO = -4142
   If IsEmpty(r.Value) Then
     r.Interior.ColorIndex = myNO
     myNO = 6: GoTo MyLine
   End If
   GetV = Left(r.Value, 1)
   If IsNumeric(GetV) Then
     Select Case GetV
      Case "1": myNO = 6
      Case "2": myNO = 4
      Case "3": myNO = 8
      Case "4": myNO = 3
     End Select
   End If
   r.Interior.ColorIndex = myNO
MyLine:
   If myNO = 6 Then
     Cells(TgR, 5).Value = 0
     Set MyR = Cells(TgR, 6).Resize(, 251)
     If WorksheetFunction.CountA(MyR) > 0 Then
      For Each rb In MyR.SpecialCells(2)
        If Left(rb.Value, 1) = 1 Then
         Cells(TgR, 5).Value = Cells(TgR, 5).Value + 1
        End If
      Next
     End If
     Set MyR = Nothing
   End If
  Next
  Application.EnableEvents = True
End Sub

【45312】Re:VBAを使った4つ以上の条件付き書式
お礼  ジジ  - 06/12/18(月) 22:44 -

引用なし
パスワード
   ありがとうございます。
コードを使わせていただきます。

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