在VBA中重新附加命名范围

我试图删除我的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并捕获相关的属性。

由于以上注释中列出的原因，您的收集方法失败： .Delete方法将删除对放入集合中的Name对象的任何引用。 您的collections将充满损坏的引用，并且不能从已损坏/无效的对象引用恢复名称。

选项显式

 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