累积在列的每个单元格中输入的当前值和先前值

Question

我想保存单个单元格的累加值。

例如：
如果在单元格 E2 中我写了 3，我希望单元格 F2 保存值 3。
如果 E2 更改为 2，则将旧值 3 添加到新值 2，并在单元格 F2 中显示 5。

Private Sub Worksheet_Change(ByVal Target As Range)  
    If Target.Address = "$E$2" Then
        Application.EnableEvents = False
        Call Update_Aa
    End If
    If Target.Address = "$E$3" Then
        Application.EnableEvents = False
        Call Update_Ab
    End If
End Sub


Sub Update_Aa()
Dim Aa As Long
Dim Ba As Long

Aa = Range("E2").Value
Ba = Range("F2").Value

Aa = Aa + Ba
Range("F2").Value = Aa
Application.EnableEvents = True
End Sub


Sub Update_Ab()
Dim Ab As Long
Dim Bb As Long

Ab = Range("E3").Value
Bb = Range("F3").Value

Ab = Ab + Bb
Range("F3").Value = Ab
Application.EnableEvents = True
End Sub

我想将其应用于“E”列中的每个单元格及其“F”中相应的单元格。
有没有办法不向每个单元格写入子内容？

Answer 1

工作表更改：累计总和

紧凑

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ClearError ' start error-handling routine
    
    ' Define constants.
    Const SRC_FIRST_CELL As String = "E2"
    Const DST_COLUMN As String = "F"
    
    ' Reference the changed cells, the Source range.
    
    Dim srg As Range
    
    With Me.Range(SRC_FIRST_CELL) ' from the first...
        Set srg = .Resize(Me.Rows.Count - .Row + 1) ' ... to the bottom cell
    End With
    
    Set srg = Intersect(srg, Target)
    If srg Is Nothing Then Exit Sub ' no changed cells
        
    ' Calculate the offset between the Source and Destination columns.
    Dim cOffset As Long: cOffset = Me.Columns(DST_COLUMN).Column - srg.Column
        
    ' Return the sum of each Source and Dest. cell in the Destination cell.
        
    Application.EnableEvents = False ' to not retrigger this event when writing
    
    Dim sCell As Range, sValue, dValue
    
    For Each sCell In srg.Cells ' current source cell
        With sCell.Offset(, cOffset) ' current destination cell
            sValue = sCell.Value
            dValue = .Value
            If VarType(sValue) = vbDouble Then ' source is a number
                If VarType(dValue) = vbDouble Then ' destination is a number
                    .Value = dValue + sValue
                Else ' destination is not a number
                    .Value = sValue
                End If
            'Else ' source is not a number; do nothing
            End If
        End With
    Next sCell
                   
ProcExit:
    On Error Resume Next ' prevent endless loop if error in the following lines
        If Not Application.EnableEvents Then Application.EnableEvents = True
    On Error GoTo 0
    Exit Sub
ClearError: ' continue error-handling routine
    Debug.Print "Run-time error '" & Err.Number & "':" & vbLf & Err.Description
    Resume ProcExit
End Sub

单独子中的方法

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ClearError ' start error-handling routine
    
    ' Define constants.
    Const SRC_FIRST_CELL As String = "E2"
    Const DST_COLUMN As String = "F"
    
    ' Reference the changed cells, the Source range.
    
    Dim srg As Range
    
    With Me.Range(SRC_FIRST_CELL) ' from the first...
        Set srg = .Resize(Me.Rows.Count - .Row + 1) ' ... to the bottom cell
    End With
    
    Set srg = Intersect(srg, Target)
    If srg Is Nothing Then Exit Sub
        
    ' Calculate the offset between the Source and Destination columns.
    Dim cOffset As Long: cOffset = Me.Columns(DST_COLUMN).Column - srg.Column
        
    ' Return the sum of each Source and Dest. cell in the Destination cell.
    Application.EnableEvents = False ' to not retrigger this event when writing
    UpdateCells srg, cOffset
    
ProcExit:
    On Error Resume Next ' prevent endless loop if error in the following lines
        If Not Application.EnableEvents Then Application.EnableEvents = True
    On Error GoTo 0
    Exit Sub
ClearError: ' continue error-handling routine
    Debug.Print "Run-time error '" & Err.Number & "':" & vbLf & Err.Description
    Resume ProcExit
End Sub

方法

Sub UpdateCells( _
        ByVal SourceRange As Range, _
        ByVal DestinationColumnOffset As Long)
    
    Dim sCell As Range, sValue, dValue
    
    For Each sCell In SourceRange.Cells ' current source cell
        With sCell.Offset(, DestinationColumnOffset) ' current destination cell
            sValue = sCell.Value
            dValue = .Value
            If VarType(sValue) = vbDouble Then ' source is a number
                If VarType(dValue) = vbDouble Then ' destination is a number
                    .Value = dValue + sValue
                Else ' destination is not a number
                    .Value = sValue
                End If
            'Else ' source is not a number; do nothing
            End If
        End With
    Next sCell

End Sub