Excel vba工作表更改事件不发生'；在某些条件下不能工作

我需要帮助

我做了一个工作表活动，代码如下：

 Private Sub Worksheet_Change(ByVal target As Range)
 Application.EnableEvents = False



 Dim ut1 As Range
 Dim ut2 As Range
 Dim ut3 As Range
 Dim ut4 As Range
 Dim ut5 As Range
 Dim ut6 As Range
 Dim ut7 As Range
 Dim ut8 As Range
 Dim ut9 As Range
 Dim ut10 As Range
 Dim ut11 As Range
 Dim ut12 As Range

 Set ut1 = ActiveSheet.Range(ActiveSheet.Cells(9, "g"), Cells(9, ActiveSheet.Cells(5, 
 Columns.Count).End(xlToLeft).Column))
 Set ut2 = ActiveSheet.Range(ActiveSheet.Cells(12, "g"), Cells(12, ActiveSheet.Cells(5, 
 Columns.Count).End(xlToLeft).Column))
 Set ut3 = ActiveSheet.Range(ActiveSheet.Cells(15, "g"), Cells(15, ActiveSheet.Cells(5, 
 Columns.Count).End(xlToLeft).Column))
 Set ut4 = ActiveSheet.Range(ActiveSheet.Cells(18, "g"), Cells(18, ActiveSheet.Cells(5, 
 Columns.Count).End(xlToLeft).Column))
 Set ut5 = ActiveSheet.Range(ActiveSheet.Cells(21, "g"), Cells(21, ActiveSheet.Cells(5, 
 Columns.Count).End(xlToLeft).Column))
 Set ut6 = ActiveSheet.Range(ActiveSheet.Cells(25, "g"), Cells(525, ActiveSheet.Cells(5, 
 Columns.Count).End(xlToLeft).Column))
 Set ut7 = ActiveSheet.Range(ActiveSheet.Cells(28, "g"), Cells(28, ActiveSheet.Cells(5, 
 Columns.Count).End(xlToLeft).Column))
 Set ut8 = ActiveSheet.Range(ActiveSheet.Cells(31, "g"), Cells(31, ActiveSheet.Cells(5, 
 Columns.Count).End(xlToLeft).Column))
 Set ut9 = ActiveSheet.Range(ActiveSheet.Cells(34, "g"), Cells(34, ActiveSheet.Cells(5, 
 Columns.Count).End(xlToLeft).Column))
 Set ut10 = ActiveSheet.Range(ActiveSheet.Cells(44, "g"), Cells(44, ActiveSheet.Cells(5, 
 Columns.Count).End(xlToLeft).Column))
 Set ut11 = ActiveSheet.Range(ActiveSheet.Cells(47, "g"), Cells(47, ActiveSheet.Cells(5, 
 Columns.Count).End(xlToLeft).Column))
 Set ut12 = ActiveSheet.Range(ActiveSheet.Cells(50, "g"), Cells(50, ActiveSheet.Cells(5, 
 Columns.Count).End(xlToLeft).Column))
 Set ut13 = ActiveSheet.Range(ActiveSheet.Cells(53, "g"), Cells(53, ActiveSheet.Cells(5, 
 Columns.Count).End(xlToLeft).Column))


 If target.Columns.Count > 1 Then Exit Sub







 If Not Intersect(target, Union(ut1, ut2, ut3, ut4, ut5, ut6, ut7, ut8, ut9, ut10, ut11, ut12, ut13)) 
 Is Nothing Then
    Call oresett(target)
  End If

 Application.EnableEvents = True

  End Sub

这是潜艇

Sub oresett(target As Range)

Dim oreturno As New Dictionary

Dim codifica As Range


Set codifica = Foglio1.Range("ai2:aj" & Foglio1.Cells(Rows.Count, "ai").End(xlUp).Row)

For i = 1 To codifica.Rows.Count
    oreturno.Add UCase(codifica.Cells(i, 1).Value), codifica.Cells(i, 2).Value

Next i

Dim data As Range
Set data = ActiveSheet.Range(ActiveSheet.Cells(5, "g"), Cells(5, ActiveSheet.Cells(5, Columns.Count).End(xlToLeft).Column))

Dim utente As Range
Dim riga As Long

riga = target.Row

Set utente = ActiveSheet.Range(ActiveSheet.Cells(riga - 1, "g"), Cells(riga, ActiveSheet.Cells(5, Columns.Count).End(xlToLeft).Column))

Dim tot As Long
Dim r As Long

tot = ActiveSheet.Cells(target.Row, "c").Value
r = 1
For i = 1 To utente.Columns.Count
    If InStr(UCase(utente.Cells(r, i).Value), UCase("x")) > 0 Then
            r = 2
        End If
        
        If InStr(UCase(data.Cells(1, i).Value), UCase("lun")) = 0 Then
            tot = oreturno(UCase(utente(r, i).Value)) + tot
            Else
            tot = oreturno(UCase(utente(r, i).Value))
            End If
                    If tot > 48 Then
                       MsgBox "superato limite delle 48 ore, riferimento cella" & " " & utente.Range(Cells(r, i), Cells(r, i)).Address
                        Exit Sub
                        
                        
                        'Else
'                        utente.Cells(r, i).Interior.ColorIndex = -4142
                    End If
     
            
        r = 1
        
        
Next i

i = ActiveSheet.Index

If i = 14 Then i = 2

Worksheets(i + 1).Cells(target.Row, "c").Value = tot






End Sub

当某个值在某个范围内发生更改时，代码需要触发，并且可以正常工作。但是，如果我选择了多个值列并清除了内容，则子项将执行“退出”子项，但它将不再工作，我必须关闭工作簿并重新打开才能再次工作

那是虫子吗？还是我做错了什么

更清楚的是，这里有一张图片

如果我清除黄色部分中的一些值，如果我只删除一个值，则会发生错误，但不会

我希望你能帮助我

提前感谢

更改工作表

• 没有测试

代码

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim rArr As Variant
    rArr = Array(9, 12, 15, 17, 21, 25, 28, 31, 34, 55, 57, 50, 53)
    
    If Target.Columns.Count > 1 Then Exit Sub
    
    Dim cCount As Long: cCount = Me.Columns.Count
    Dim n As Long: n = LBound(rArr)
    Dim rg As Range
    Set rg = Range(Cells(rArr(n), "G"), Cells(rArr(n), cCount).End(xlToLeft))
    For n = n + 1 To UBound(rArr)
        Set rg = Union(rg, _
            Range(Cells(rArr(n), "G"), Cells(rArr(n), cCount).End(xlToLeft)))
    Next n
    
    Set rg = Intersect(Target, rg)
    If rg Is Nothing Then Exit Sub
        
    Application.EnableEvents = False
    On Error GoTo clearError
    oresett rg
        
SafeExit:
    Application.EnableEvents = True
clearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit

End Sub

---

我们可以看一下

oresett

程序吗。还有这个

单元格（525

打字错误。我把oresettsub@BigBen我想我不明白你的意思，sub不会触发任何错误，我使用enable event=false来避免循环

如果target.Columns.Count>1，然后退出sub

在这里，你退出sub而不重新打开事件处理…@Tim Williams:谢谢。今天不是我的日子。