使用 Select 大小写来引用命名范围中的所有行
Using Select Case to reference all rows in Named Range
我有以下工作表更改代码。当前迭代我会在每个 Case 中手动指定行号,效果很好。
每个案例的数量或行由另一个宏动态更改,该宏将插入或删除 2 个命名范围内的行 "TotalAcc" & "TotalRate"。
我有没有办法修改它,以便案例将引用命名范围内的所有行或单元格?
提前谢谢你。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, Inte As Range, r As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = ThisWorkbook.Worksheets(1)
Set ws2 = ThisWorkbook.Worksheets(2)
Set A = Range("TotalAcc", "TotalRate")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
If Target.Columns.Count > 1 Then Exit Sub
Application.EnableEvents = False
For Each r In Inte
Select Case Target.Row
Case 10, 11, 12, 13, 14, 15
Range("A" & r.Row).Offset(0, 3).Value = Application.WorksheetFunction.SumIfs(ws2.Range("Y:Y"), ws2.Range("D:D"), ws1.Range("A" & r.Row), ws2.Range("AB:AB"), ws1.Range("B" & r.Row), ws2.Range("M:M"), ws1.Range("C" & r.Row))
Range("A" & r.Row).Offset(0, 5).Value = Application.WorksheetFunction.SumIfs(ws2.Range("P:P"), ws2.Range("D:D"), ws1.Range("A" & r.Row), ws2.Range("AB:AB"), ws1.Range("B" & r.Row), ws2.Range("M:M"), ws1.Range("C" & r.Row))
Case 18, 19, 20, 21
If Range("E" & r.Row).Value <> "" Then
Range("C" & r.Row).Value = Application.WorksheetFunction.SumIfs(ws2.Range("Y:Y"), ws2.Range("V:V"), ws1.Range("E" & r.Row))
Range("E" & r.Row).Offset(0, -1).Value = "CONTRACTS@"
Range("E" & r.Row).Offset(0, 1).Value = Application.WorksheetFunction.Product(Range("C" & r.Row), Range("E" & r.Row))
Else:
Range("C" & r.Row).Value = ""
Range("E" & r.Row).Offset(0, -1).Value = ""
Range("E" & r.Row).Offset(0, 1).Value = ""
End If
End Select
Next r
Application.EnableEvents = True
像这样更简单:
For Each r In Inte
If not Application.Intersect(r, Range("TotalAcc")) Is Nothing Then
'is in TotalAcc
Else
'is in TotalRate
End if
Next r
您发布的代码中仅供参考:
Select Case Target.Row
如果 Target 中有多个单元格,这只会查看第一个单元格。应该是
Select Case r.Row
我有以下工作表更改代码。当前迭代我会在每个 Case 中手动指定行号,效果很好。
每个案例的数量或行由另一个宏动态更改,该宏将插入或删除 2 个命名范围内的行 "TotalAcc" & "TotalRate"。
我有没有办法修改它,以便案例将引用命名范围内的所有行或单元格?
提前谢谢你。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, Inte As Range, r As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = ThisWorkbook.Worksheets(1)
Set ws2 = ThisWorkbook.Worksheets(2)
Set A = Range("TotalAcc", "TotalRate")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
If Target.Columns.Count > 1 Then Exit Sub
Application.EnableEvents = False
For Each r In Inte
Select Case Target.Row
Case 10, 11, 12, 13, 14, 15
Range("A" & r.Row).Offset(0, 3).Value = Application.WorksheetFunction.SumIfs(ws2.Range("Y:Y"), ws2.Range("D:D"), ws1.Range("A" & r.Row), ws2.Range("AB:AB"), ws1.Range("B" & r.Row), ws2.Range("M:M"), ws1.Range("C" & r.Row))
Range("A" & r.Row).Offset(0, 5).Value = Application.WorksheetFunction.SumIfs(ws2.Range("P:P"), ws2.Range("D:D"), ws1.Range("A" & r.Row), ws2.Range("AB:AB"), ws1.Range("B" & r.Row), ws2.Range("M:M"), ws1.Range("C" & r.Row))
Case 18, 19, 20, 21
If Range("E" & r.Row).Value <> "" Then
Range("C" & r.Row).Value = Application.WorksheetFunction.SumIfs(ws2.Range("Y:Y"), ws2.Range("V:V"), ws1.Range("E" & r.Row))
Range("E" & r.Row).Offset(0, -1).Value = "CONTRACTS@"
Range("E" & r.Row).Offset(0, 1).Value = Application.WorksheetFunction.Product(Range("C" & r.Row), Range("E" & r.Row))
Else:
Range("C" & r.Row).Value = ""
Range("E" & r.Row).Offset(0, -1).Value = ""
Range("E" & r.Row).Offset(0, 1).Value = ""
End If
End Select
Next r
Application.EnableEvents = True
像这样更简单:
For Each r In Inte
If not Application.Intersect(r, Range("TotalAcc")) Is Nothing Then
'is in TotalAcc
Else
'is in TotalRate
End if
Next r
您发布的代码中仅供参考:
Select Case Target.Row
如果 Target 中有多个单元格,这只会查看第一个单元格。应该是
Select Case r.Row