能否创建绑定ActiveSheet而非指定工作表的Excel命名区域？

方案1：批量创建工作表级命名区域（最稳定） #

Excel的命名区域分全局级和工作表级，全局级会强制绑定创建时的工作表，而工作表级的名称只属于当前工作表，不同表可以用同名。你可以批量给10个表创建同名的工作表级命名区域，步骤如下：

• 按Ctrl+F3打开名称管理器
• 点击「新建」，名称填rnge1，范围选当前工作表（比如Sheet1），引用位置填=Sheet1!$E$2:$E$7（或者用动态公式=Sheet1!$E$2:INDEX(Sheet1!$E:$E,COUNTA(Sheet1!$E:$E))实现随行添加自动扩展）
• 重复这个操作，给每个工作表都创建rnge1、rnge2、rnge3三个工作表级名称

这样你的宏不用改，ws.Range("RNGE1")会自动指向当前激活工作表的对应区域，完全符合需求。如果怕手动创建麻烦，可以用下面的VBA批量生成：

Sub 批量创建工作表级命名区域()
    Dim ws As Worksheet
    ' 遍历所有需要设置的工作表（可根据实际修改，比如只遍历特定表）
    For Each ws In ThisWorkbook.Worksheets
        ' 创建rnge1：E2开始到E列最后一行非空单元格
        ws.Names.Add Name:="rnge1", RefersTo:="=" & ws.Name & "!$E$2:INDEX(" & ws.Name & "!$E:$E,COUNTA(" & ws.Name & "!$E:$E))"
        ' 创建rnge2：E213到E184（注意这里是逆序，你可以根据实际调整）
        ws.Names.Add Name:="rnge2", RefersTo:="=" & ws.Name & "!$E$184:$E$213"
        ' 创建rnge3：E281到E列最后一行非空单元格，动态扩展的话改成类似rnge1的公式
        ws.Names.Add Name:="rnge3", RefersTo:="=" & ws.Name & "!$E$281:INDEX(" & ws.Name & "!$E:$E,COUNTA(" & ws.Name & "!$E:$E))"
    Next ws
End Sub

方案2：全局动态名称（无需批量创建） #

如果不想给每个表单独建名称，可以创建全局动态名称，利用CELL函数获取当前工作表名，结合INDIRECT实现跨表自动切换：

• 打开名称管理器，新建全局名称rnge1，引用位置填：

  =INDIRECT(ADDRESS(2,5,,,CELL("sheet"))&":"&ADDRESS(COUNTA(INDIRECT(CELL("sheet")&"!E:E")),5,,,CELL("sheet")))
  

  这个公式会自动获取当前激活工作表的E列，从第2行到最后一行非空单元格，实现随行添加自动更新。同理设置rnge2和rnge3：

  • rnge2：=INDIRECT(CELL("sheet")&"!$E$184:$E$213")
  • rnge3：=INDIRECT(ADDRESS(281,5,,,CELL("sheet"))&":"&ADDRESS(COUNTA(INDIRECT(CELL("sheet")&"!E:E")),5,,,CELL("sheet")))

  注意：CELL函数依赖单元格的计算刷新，宏运行时会自动触发计算，所以不会有问题。

方案3：宏内动态计算区域（完全不用命名区域） #

如果连命名区域都不想用，直接在宏里根据规则获取当前工作表的对应区域，代码修改如下：

Sub DELETE_E()
    Dim ws As Worksheet, rng1 As Range, rng2 As Range, rng3 As Range
    Set ws = ActiveSheet
    
    ' 定义rnge1：E2到E列最后一行非空单元格
    Set rng1 = ws.Range("E2:E" & ws.Cells(ws.Rows.Count, "E").End(xlUp).Row)
    ' 定义rnge2：E184到E213（注意逆序，按需调整）
    Set rng2 = ws.Range("E184:E213")
    ' 定义rnge3：E281到E列最后一行非空单元格
    Set rng3 = ws.Range("E281:E" & ws.Cells(ws.Rows.Count, "E").End(xlUp).Row)
    
    ' 执行原代码逻辑
    rng3.ClearContents
    
    With rng2
        .Formula = Evaluate("IF(LEFT(FORMULATEXT(" & .Address & "),8)=""=Left($B"","""",FORMULATEXT(" & .Address & "))")
        .Formula = Evaluate("IF(LEFT(FORMULATEXT(" & .Address & "),7)=""=MISC.!"""","""",FORMULATEXT(" & .Address & "))")
        .Formula = Evaluate("IF(LEFT(FORMULATEXT(" & .Address & "),3)=""=$B"","""",FORMULATEXT(" & .Address & "))")
        .Formula = Evaluate("IF(LEFT(FORMULATEXT(" & .Address & "),7)=""=MID($B"","""",FORMULATEXT(" & .Address & "))")
        On Error Resume Next
        .SpecialCells(xlCellTypeConstants).ClearContents
        On Error GoTo 0
    End With
    
    With rng1
        On Error Resume Next
        .SpecialCells(xlCellTypeConstants).ClearContents
        On Error GoTo 0
    End With
End Sub

这样直接在宏里动态获取区域，不用依赖命名区域，也能实现随行自动扩展。

内容的提问来源于stack exchange，提问作者Quasar