我正在尝试在具有两行数据的两个范围中添加值。
宏的第一部分将输入的命名范围定位到目标单元格,然后将该命名范围复制到与目标单元格相邻的部分。
我不知道如何使用我已有的内容,因此当在第一部分中的原始单元格下添加第二个输入时,现在要对两个输入的命名范围求和,如上面的示例所示。
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