对两个不同范围内的值求和

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

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

• Range1A2:E3
• Range2A6:E7
• OutcomeA10:E11

只需使用数组公式：

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

或没有命名范围：

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