我有下面的代码做3件事：
1.在单元格F3中，它将所有文本上移，如果尚未输入，则添加单词“cassa”;
1.在单元格F25中输入最后一次编辑的日期和时间;
1.在范围H5：H12和D18：K19中，如果用户删除单元格的内容，则插入零。
我注意到当在表格中的单元格之间移动时会有轻微的滞后。我确信这段代码可以优化以加快速度，但是我卡住了。任何帮助都将非常感激。谢谢。

Private Sub WorkSheet_Change(ByVal Target As Range)
    Const RNG_TS As String = "F25" 'cella dove mostro "aggiornamento giacenza"
    Const rng As String = "F3" 'cella "nome cassa"
    Dim stringa As String

    Dim TargetDateRange As Range
    Set TargetDateRange = Union(Worksheets("GIACENZA MONETE").Range("H5:H12"), Worksheets("GIACENZA MONETE").Range("D18:K19"))

    If Target.Cells.CountLarge > 1 Then Exit Sub

    If Target.Address = Me.Range(RNG_TS).Address Then Exit Sub 'prevent re-entry
    
    Me.Range(RNG_TS).Value = "Aggiornamento giacenza: " & _
                             Format(Now(), "dd/mm/yyyy - hh:mm:ss")
    
    If Target.Address = Me.Range(rng).Address Then
        stringa = UCase(Trim(Target.Value)) 
        If InStr(1, stringa, "cassa", vbTextCompare) = 0 Then stringa = "CASSA " & stringa
        On Error GoTo haveError
        Application.EnableEvents = False
        Target.Value = stringa
         Application.EnableEvents = True
    End If
    

    
    If Not TargetDateRange Is Nothing Then

        Application.EnableEvents = False

        If ActiveCell.Value = "" Or ActiveCell.Value = vbNullString Or Trim(ActiveCell.Value) = "" Then
            ActiveCell.Value = 0
        End If
        
    End If
    

    
    
haveError:

     Application.EnableEvents = True

End Sub