Excel VBA質問箱 IV

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

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


36630 / 76732 ←次へ | 前へ→

【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

0 hits

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

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