A工作表变更：累计金额

紧凑型

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

单独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