通过覆盖仅适用于某些命名范围将命名范围范围从工作表转换为工作簿

Convert named range scope from Worksheet to Workbook by overwriting only works for some named ranges

我已经破解了代码(来自几个来源,底部的参考)以编程方式将工作表范围内的命名范围转换为工作簿命名范围。但是我的代码只适用于一些命名范围而不适用于其他范围,我不明白为什么。

我必须这样做的原因是因为我必须从原始来源中删除两个选项卡(一个包含 _T 和另一个包含 _X 的选项卡)并从另一个来源复制这些选项卡的副本。这给我留下了#REF!#REF 的工作簿范围命名范围和具有我想要的范围但我需要它们的工作簿范围的工作表命名范围。

见下方代码

如果我 运行 此代码寻找“_T”,它会完美运行。所有以 _T 开头的名为 #REF!#REF 的工作簿命名范围现在都具有正确的范围,并且它们的对应工作表命名范围已被删除。但是,如果我 运行 正在寻找“_X”,则名为 range 的工作簿将保持不变。我很难过。我什至尝试了一种不同的方法,我手动删除了所有以 _X 开头的命名范围的当前工作簿,然后以编程方式尝试使用 ActiveWorkbook.Names.Add Name:=newNm,RefersTo:=nm.RefersTo 添加它们,这也什么都不做(甚至不添加新记录)。

在此先感谢您的帮助。

Sub WStoWBscope()

Dim nm As Name, Ans As Integer, newNm As String, fltr As String

fltr = "_X" 'search string


For Each nm In ActiveWorkbook.Names                'look at all named ranges within the current workbook
    If nm.Name Like "X!*" Then                     'looks for worksheet scoped named range that has the correct range
        If InStr(1, nm.Name, fltr) > 0 Then
            newNm = Replace(nm.Name, "X!", "")     'save name of existing workbook named range
            Range(nm.RefersTo).Name = newNm        'overwrite workbook named range with proper range
            nm.Delete                              'deletes worksheet named range
        End If
    End If
Next nm
End Sub

VBA to Convert Named Ranges Workbook to Worksheet Scope VBA to change the scope of named ranges from worksheet level to workbook

试试这个:

Sub ConvertWorksheetNamedRangesToWorkbookNamedRanges()
    Dim nName As Name
    'Loop Through each named Range
    For Each nName In ActiveWorkbook.Names
        'Is Name scoped at the Workbook level?
        If TypeOf nName.Parent Is Workbook Then

        End If
        'Is Name scoped at the Worksheet level?
        If TypeOf nName.Parent Is Worksheet Then
            ' If nm.Name Like "X!*" Then .....
            ' Do the filtering you need
            ' ....
                Dim sName As String
                sName = nName.Name 'Save the name of the name
                Dim rngName As Range
                Set rngName = Range(nName) ' Save the range of the name
                nName.delete    ' Delete the name
                'Create a new one on workbook scope
                ThisWorkbook.Names.Add Name:=sName, RefersToR1C1:="=" & rngName.Address(ReferenceStyle:=xlR1C1)
            ' End If
        End If
    Next nName
End Sub

仅出于文档目的(不要对此投票,请为 Viktor 的回答投票)代码的最终版本如下所示:

Dim nm As Name, Ans As Integer, newNm As String, fltr As String, rngName As Range

'Filter named ranges that contain specific phrase
fltr = "_X"

'Search for all names in the workbook
For Each nm In ActiveWorkbook.Names
    'Search within those named ranges by those that have a specific worksheet scope
    If nm.Name Like "X!*" Then
        'Search for the named ranges of a type set by your filter (fltr)
        If InStr(1, nm.Name, fltr) > 0 Then
            'Take the full name [Scope]+[named range] and remove the scope
            newNm = Replace(nm.Name, "X!", "")
            'save the original range used by the worksheet-scoped named range 
            Set rngName = Range(nm)
            'delete the worksheet-scoped named range
            nm.Delete    
            'Create/Overwrite a workbook-scoped named range (this does overwrite any workbook-scoped named ranges that are the same name with #REF!#REF )
            ThisWorkbook.Names.Add Name:=newNm, RefersToR1C1:="=" & rngName.Address(ReferenceStyle:=xlR1C1)
        End If
    End If
Next nm
End Sub