两个范围内的值求和

Question

我正在尝试在具有两行数据的两个范围中添加值。

示例：

宏的第一部分将输入的命名范围定位到目标单元格，然后将该命名范围复制到与目标单元格相邻的部分。

我不知道如何使用我已有的内容，因此当在第一部分中的原始单元格下添加第二个输入时，现在要对两个输入的命名范围求和，如上面的示例所示。

Private Sub Worksheet_Change(ByVal Target As Range)
    
    On Error GoTo ErrorHandler
    
    '1: FIRST LABEL VALUES
    If Not Intersect(Target, Range("J6:J7500")) Is Nothing Then
    
        Application.ScreenUpdating = False
    
        If Target = vbnulstring Then Exit Sub
    
        If Target.Column = 10 And Target.Offset(0, -1).Value > 0 Then
            
            'Find Named Range, Go To It and Copy It
            Dim NamedRange As Range
            Dim LabelCode As Range
            Dim name As String
            
            Range("BT2", Range("BT2").End(xlDown)).Select
            Set NamedRange = Selection
            Range("BS2", Range("BS2").End(xlDown)).Select
            Set LabelCode = Selection
            
            name = WorksheetFunction.Index(NamedRange, WorksheetFunction.Match(Target.Value, LabelCode, 0))
            
            Application.GoTo Reference:=ActiveWorkbook.Names(name).name
            
            Selection.Copy

            Target.Offset(-2, 3).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Application.CutCopyMode = False
            
            'Apply % To New Numbers
            Dim rng As Range
            Dim myVal As Range

            Set rng = Selection

            For Each myVal In rng
                myVal = myVal.Value * Target.Offset(0, -1).Value
            Next myVal
            
            Target.Select

        End If
        
        Application.ScreenUpdating = True
        
    End If
    
    
    '2: SUM FIRST LABEL VALUES AND SECOND LABEL VALUES
    If Not Intersect(Target, Range("J6:J7500")) Is Nothing Then
    
        Application.ScreenUpdating = False
    
        If Target = vbnulstring Then Exit Sub
    
        If Target.Column = 10 And Target.Offset(-1, 0).Value <> "" Then
            
            'Find Named Range, Go To It and Copy It
            Dim NamedRange As Range
            Dim LabelCode As Range
            Dim name1 As String
            Dim name2 As String
            
            Range("BT2", Range("BT2").End(xlDown)).Select
            Set NamedRange = Selection
            Range("BS2", Range("BS2").End(xlDown)).Select
            Set LabelCode = Selection
            
            name1 = WorksheetFunction.Index(NamedRange, WorksheetFunction.Match(Target.Offset(-1, 0).Value, LabelCode, 0))
            
            Application.GoTo Reference:=ActiveWorkbook.Names(name1).name
            
            'Find Second Named Range And Add It To First Named Range
            name2 = WorksheetFunction.Index(NamedRange, WorksheetFunction.Match(Target.Value, LabelCode, 0))
            
            Application.GoTo Reference:=ActiveWorkbook.Names(name2).name
            
            'Add Values Together
            'HOW DO I DO THIS????
            
            'Apply % To New Numbers
            Dim rng As Range
            Dim myVal As Range

            Set rng = Selection

            For Each myVal In rng
                myVal = myVal.Value * Target.Offset(0, -1).Value
            Next myVal
            
            Target.Select

        End If
        
        Application.ScreenUpdating = True
        
    End If

ErrorHandler:
Exit Sub

Answer 1

如果您已命名范围，例如：

• Range1

  A2:E3

• Range2

  A6:E7

• Outcome

  A10:E11

只需使用数组公式：

Range("Outcome").FormulaArray = "=Range1+Range2"

或没有命名范围：

Range("A10:E11").FormulaArray = "=A2:E3+A6:E7"