VBA Private Sub Worksheet_Changeで

現在下記のコードで”●”を転記することはできるのですがクリアすることもしたいのです
動作としてはsheet1のP.R.T列に値が入ったら各sheetの指定したセルに●を転記させています
今度はsheet1のP.R.T列に値が修正されたときや消されたときには今まで●が転記されていたsheetのセルから●を消したいのです修正された場合は今までのセルを消して指定したセルに転記です
AIに相談してもうまくいきませんでした、どのようにしたらうまくいくでしょうか？
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("AC:AC")) Is Nothing Then
If Application.WorksheetFunction.CountIf(Target, "撤去") > 0 Then
MsgBox "AC列の変更が検出されました。"
FindAndActivateSheet Target
End If
End If

Dim KeyCells As Range
Set KeyCells = Union(Me.Range("P:P"), Me.Range("R:R"), Me.Range("T:T"))

If Not Intersect(Target, KeyCells) Is Nothing Then
Dim cell As Range
For Each cell In Intersect(Target, KeyCells)
If cell.Value <> "" And InStr(cell.Value, "→") = 1 Then
Dim searchValues As Variant
searchValues = Split(Mid(cell.Value, 2), "-")
If UBound(searchValues) >= 2 Then
Dim sheetName As String
Dim cellRef As String
sheetName = searchValues(0)
cellRef = searchValues(1)
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(sheetName)
On Error GoTo 0
If Not ws Is Nothing Then
Dim checkCells As Range
Dim c As Range
Set checkCells = ws.Range("I3, I9, I15, I21, I27, I33")
For Each c In checkCells
If Trim(c.Value) = Trim(cellRef) Then
Dim markCell As Range
Set markCell = ws.Range("I" & c.row + 1 & ":AF" & c.row + 3).Find(What:=searchValues(2), LookIn:=xlValues, LookAt:=xlWhole)
If Not markCell Is Nothing Then
Dim words As Variant
words = Split(markCell.Value, " ")
Dim word As Variant
Dim markFound As Boolean
markFound = False
For Each word In words
If Trim(word) = Trim(searchValues(2)) Then
markFound = True
Exit For
End If
Next word
If markFound Then
markCell.Offset(1, 0).Value = "●"
End If
End If
End If
Next c
End If
End If
End If
Next cell
End If

' P、R、T列の値がない場合、各シートのマークがあるセルをクリアする
Dim ws_clear As Worksheet
For Each ws_clear In ThisWorkbook.Sheets
If ws_clear.Name <> Me.Name Then ' 自身のワークシート以外のみを処理
Dim markRange As Range
Dim clearCell As Range
Set markRange = ws_clear.Range("I:AF") ' マークを探す範囲を指定
For Each clearCell In markRange
' セルの上の行が存在し、かつセルの値が "●" の場合にマークをクリア
If Not IsEmpty(clearCell.Offset(-1, 0)) And clearCell.Value = "●" Then
clearCell.ClearContents ' 値がないのにマークがある場合、マークをクリア
End If
Next clearCell
End If
Next ws_clear
End Sub

質問者からの補足コメント

• 各sheetには同じ場所に配置していますこの表に●をsheet1の列に入れた値で転記させています
  そのsheet1の列で修正された場合に●のクリアまたは移動してくれたらありがたいのですが・・・

  
    補足日時：2024/05/02 09:12

No.1 回答者： yokomaya 回答日時： 2024/05/07 14:03

イベント処理のデバッグについて学習していないことがよくわかる

ご質問です。
というのはイベント処理というのはデバッグで
ステップ実行して追跡することが不可欠なんですけど
それをやっていないことがわかるコードになっているからです。
具体的に言うとこのコードの先頭の
If Not Intersect(Target, Me.Range("AC:AC")) Is Nothing Then
の行にブレークポイントをセットしていずれかのセルを
変更すると、その行で停止しますよね？
そこからステップ実行で動作を追跡しないといけないのです。
なぜそれをやっていないことがわかるかというと
このあとのコードでセルを変更したときに、先頭に戻ってしまう
症状を確認していないことがうかがえるからです。
Application.EnableEventsについて調べることを
お勧めします。
そっちのほうがご質問よりも先に解決すべき課題ですから。

この回答へのお礼

回答ありがとうございます、投稿してから時間がたちすでに解決済みです

お礼日時：2024/05/07 15:14