VBA 为什么 Delete Shift Up 会删除它下面的所有内容?

VBA Why does Delete Shift Up delete everything below it?

所以我的代码只要在 sheet 上添加一个名称,然后将该名称添加到所有其他 sheet,并且每当从同一个 sheet 中删除一个名称时,它应该从所有其他 sheet 中删除(这些是下面选定的 sheet)。但是出于某种原因 运行 ActiveCell.EntireRow.Delete Shift:=xlUp 也删除了 ActiveCell 以下的所有内容?这是我目前的全部代码。

Private Sub Worksheet_Change(ByVal Target As Range)
    Const cCol As String = "A"
    Const fRow As Long = 2
    
    Dim crg As Range
    Dim ddFound As Range
    Dim ws As Worksheet
    Dim sh As Worksheet
    Dim outpt As String
    Dim i As Integer

    Set crg = Worksheets("Statistics").Columns(cCol).Resize(Rows.Count - fRow + 1).Offset(fRow - 1)
    Dim irg As Range: Set irg = Intersect(crg, Target)
    Dim sraddress As String
    Dim statdel As Range
    
    Dim dws As Worksheet
    Dim ddcrg As Range
    Dim statrange As Range
    
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        sraddress = CStr(irg.Value)
        
        Application.ScreenUpdating = False
        Application.EnableEvents = False

        For Each ws In ActiveWorkbook.Worksheets
            Set ddcrg = ws.Columns(cCol)
            Set ddFound = ddcrg.Find(sraddress, , xlValues, xlWhole)
            
            If sraddress <> "" Then
                irg.Select:   ActiveCell = irg.Value2
                irg.Copy
                ws.Range(irg.Address) = irg.Value2
                Application.CutCopyMode = False
            ElseIf sraddress = "" Then
                Dim Deladdrs As String
                irg.EntireRow.Select
            
                On Error Resume Next

                Sheets(Array("Statistics", "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")).Select
            
                Deladdrs = ActiveCell.Address(0, 0)
                
                ActiveCell.EntireRow.Delete Shift:=xlUp
        
                Application.CutCopyMode = False
            Else
            End If
        Next ws
    
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    Else
    End If
End Sub

请测试下一个代码。它假定只应更新数组中的工作表(来自您的代码)。而且,在删除名称的情况下,包含它的行也应该被删除。该代码还涵盖了行删除的情况,否则应该将值放在要更新的工作表的所有行上的新 Target 的 A:A 中:

Private Sub Worksheet_Change(ByVal Target As Range)
    Const cCol As String = "A", fRow As Long = 2
    
    Dim crg As Range, ws As Worksheet
    Dim irg As Range, irgVal As String

    If Target.Rows.Count > 1 then exit sub. Not allowed more rows to be deleted, changed.
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Set crg = Me.Columns(cCol).Resize(rows.Count - fRow + 1).Offset(fRow - 1)
        Set irg = Intersect(crg, Target)
        irgVal = irg.value
        If Target.Columns.Count = 16384 Then irgVal = "" 'for the case of deleting the whole row!
        Application.ScreenUpdating = False
        Application.EnableEvents = False

        For Each ws In Worksheets(Array("January", _
                               "February", "March", "April", "M)
            
            If irgVal <> "" Then
                ws.Range(Target.Address).value = irg.value
            Else
                ws.rows(irg.row).EntireRow.Delete
            End If
        Next ws
        If CStr(irg.value) = "" Then irg.EntireRow.Delete 'delete also the Target row...

        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End If
End Sub

以上代码不是为多行删除设计的,改

可以设计一个触发Row deletion的事件(Ribbon级别),但是没有使问题的对象...