两个不同范围内的求和值

如何解决两个不同范围内的求和值

我正在尝试将两个单独的范围中的值相加在一起，其中包含两行数据。下面是我要查找的示例：

我到目前为止的代码可以在下面找到。

宏的第一部分工作完美。它允许我从输入到目标单元格中​​找到命名范围，复制该命名范围，然后放置在与目标单元格相邻的部分。

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

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("BS2").End(xlDown)).Select
            Set LabelCode = Selection
            
            name1 = WorksheetFunction.Index(NamedRange,WorksheetFunction.Match(Target.Offset(-1,0).Value,0))
            
            Application.GoTo Reference:=ActiveWorkbook.Names(name1).name
            
            
            
            'Find Second Named Range And Add It To First Named Range
            name2 = WorksheetFunction.Index(NamedRange,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

任何帮助将不胜感激！

解决方法

如果您命名的范围如下：

• Range1 A2：E3
• Range2 A6：E7
• Outcome A10：E11

只需使用一个数组公式：

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

或没有命名范围：

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