Question

我尝试删除Excel工作簿中的所有命名范围，将它们存储在集合中，删除后将其重新连接到我的工作簿。

我的代码看起来像这样

Sub ResetNamedRanges()
    Dim rName As Excel.Name
    Dim cName As Excel.Name
    Dim rangedNames As Excel.names
    Dim collNames As New Collection

    Set rangedNames = ThisWorkbook.names

    For Each rName In rangedNames
        collNames.Add rName 
        rName.Delete
    Next

    For Each cName In collNames
        names.Add cName.Name, cName.RefersTo, cName.Visible, cName.MacroType, cName.ShortcutKey, cName.Category, cName.NameLocal, cName.RefersToLocal, cName.CategoryLocal, cName.RefersToR1C1, cName.RefersToR1C1Local
    Next
End Sub

但它不起作用。别忘了我错过了什么。

Answer 1

使用Dictionary并捕获相关属性。

您的Collection方法因上述注释中列出的原因而失败：.Delete方法删除对您放入集合中的Name对象的任何引用。您的集合中将包含已损坏的引用，并且您无法从损坏/无效的对象引用中恢复名称。

选项明确

Sub foo()
Dim rName As Name
Dim dictNames As Object

Set dictNames = CreateObject("Scripting.Dictionary")

For Each rName In Names
        'We're going to use a dict for the properties, also:
        dictNames.Add rName.Name, Nothing
        Set dictNames(rName.Name) = CreateObject("Scripting.Dictionary")
        With dictNames(rName.Name)
            ' Not my favorite way to do this, but some properties undefined will raise an error
            ' you can work a better way to do this if you prefer
            On Error Resume Next
            .Add "RefersTo", rName.RefersTo
            .Add "Visible", rName.Visible
            .Add "MacroType", rName.MacroType
            .Add "ShortcutKey", rName.ShortcutKey
            .Add "Category", rName.Category
            .Add "NameLocal", rName.NameLocal
            .Add "RefersToLocal", rName.RefersToLocal
            .Add "CategoryLocal", rName.CategoryLocal
            .Add "RefersToR1C1", rName.RefersToR1C1
            .Add "RefersToR1C1Local", rName.RefersToR1C1Local
            On Error GoTo 0
        End With
        rName.Delete
    Next

Dim itm
For Each itm In dictNames
    Set rName = Names.Add(itm, dictNames(itm)("RefersTo"))
    On Error Resume Next
    'rName.RefersTo = itm("RefersTo")
    rName.Visible = itm("Visible")
    rName.MacroType = itm("MacroType")
    rName.ShortcutKey = itm("ShortCutKey")
    rName.Category = itm("Category")
    rName.NameLocal = itm("NameLocal")
    rName.RefersToLocal = itm("RefersToLocal")
    rName.CategoryLocal = itm("CategoryLocal")
    rName.RefersToR1C1 = itm("RefersToR1C1")
    rName.RefersToR1C1Local = itm("RefersToR1C1Local")
    On Error GoTo 0
Next
End Sub

在VBA中重新附加命名范围

1 个答案: