我正在尝试将两个单独范围内的值添加在一起,其中有两行数据。我正在寻找的示例如下:
我到目前为止的代码可以在下面找到。
宏的第一部分完美运行。它允许我从输入到目标单元格中找到命名范围,复制该命名范围,然后放置在与目标单元格相邻的部分中。
但是,我不知道如何使用我已经拥有的内容,因此当在第一部分的原始单元格下添加第二个输入时,现在要对两个输入的命名范围求和,如上例所示。
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
任何帮助将不胜感激!