请求优化VBA宏：为多工作表创建、存储及删除Named Range

一、修复删除命名范围宏 #

原删除宏的核心问题是直接操作字符串而非工作簿的命名范围对象，逻辑完全错误。修复后的代码会精准定位对应工作表的命名范围（替换空格为下划线），判断存在后安全删除：

Sub DeleteNamedRanges()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim targetName As String
    
    ' 遍历所有工作表，删除对应命名范围
    For Each ws In ActiveWorkbook.Worksheets
        targetName = Replace(ws.Name, " ", "_")
        ' 判断命名范围是否存在，避免运行报错
        If Not ActiveWorkbook.Names(targetName) Is Nothing Then
            ActiveWorkbook.Names(targetName).Delete
        End If
    Next ws
    
    ' 可选：自动清理之前创建的"namedranges"工作表
    On Error Resume Next
    ActiveWorkbook.Worksheets("namedranges").Delete
    On Error GoTo 0
    
    Application.ScreenUpdating = True
End Sub

二、优化创建命名范围宏 #

原代码包含冗余的Activate和With ActiveWindow操作，优化后去掉无效步骤，增加重复创建判断，避免运行报错：

Sub CreateSheetNamedRanges()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim targetName As String
    Dim rng As Range
    
    For Each ws In ActiveWorkbook.Worksheets
        targetName = Replace(ws.Name, " ", "_")
        Set rng = ws.Range("A1")
        
        ' 先判断命名范围是否已存在，避免重复创建
        If ActiveWorkbook.Names(targetName) Is Nothing Then
            ActiveWorkbook.Names.Add Name:=targetName, RefersTo:=rng
        End If
    Next ws
    
    Application.ScreenUpdating = True
End Sub

三、改用数组存储命名范围映射（替代工作表存储） #

如果不需要可视化查看，而是用数组存储工作表名与对应命名范围的映射，可使用以下代码，映射结果可直接在其他VBA逻辑中调用：

Sub StoreNamedRangesToArray()
    Dim ws As Worksheet
    Dim nameMapping() As Variant
    Dim arrIndex As Integer
    
    ' 初始化数组，2列分别存储工作表名、命名范围名称
    ReDim nameMapping(1 To ActiveWorkbook.Worksheets.Count, 1 To 2)
    arrIndex = 1
    
    For Each ws In ActiveWorkbook.Worksheets
        nameMapping(arrIndex, 1) = ws.Name
        nameMapping(arrIndex, 2) = Replace(ws.Name, " ", "_")
        arrIndex = arrIndex + 1
    Next ws
    
    ' 示例：在立即窗口打印数组内容（可根据需求修改为后续业务逻辑）
    Dim i As Integer
    For i = 1 To UBound(nameMapping)
        Debug.Print "工作表：" & nameMapping(i, 1) & " 对应命名范围：" & nameMapping(i, 2)
    Next i
End Sub

使用说明 #

1. 创建命名范围：运行CreateSheetNamedRanges，自动为每个工作表的A1单元格创建命名（工作表名空格替换为下划线）
2. 存储映射到数组：运行StoreNamedRangesToArray，将工作表与命名范围的关系存入数组，供其他宏直接调用
3. 删除命名范围：运行DeleteNamedRanges，批量删除所有对应工作表的命名范围，同时自动清理冗余的"namedranges"工作表

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