用命名范围替换坐标参考 [英] Replace coordinate references with named ranges

问题描述

我有一个巨大的xlsm文件，其中包含约10,000个命名范围和22个工作表.我需要用相应的命名范围替换公式中的坐标引用.我已经尝试过以下脚本:

I have a huge xlsm file with about a 10,000 named ranges and 22 worksheets. I need to replace the coordinate references in formulas with the corresponding named ranges. I have tried this script:

Sub Ref2Named()
    Dim Nm As Name
    For Each Nm In ThisWorkbook.Names
        ActiveSheet.Cells.ApplyNames Names:=Nm.Name
    Next Nm
End Sub

但是它返回错误1004 Microsoft Excel找不到任何要替换的引用.

But it returns error 1004 Microsoft Excel cannot find any references to replace.

推荐答案

首先，可以用单行替换整个代码:

First of all, the entire code could possibly be replaced by the single line:

ActiveSheet.Cells.ApplyNames

，完全没有子要求.文档将name参数描述为名称数组如果忽略此参数，则工作表上的所有名称都将应用到该范围."但是，目前尚不清楚这是否适用于工作簿的名称集合中的每个名称.

with no sub at all required. The documentation describes the name parameter as "An array of the names to be applied. If this argument is omitted, all names on the sheet are applied to the range." But -- it isn't clear that this would apply every name in the workbook's name collection.

如果您确实需要一个子-请注意，文档中提到使用名称的 array .为此，您可以使用 Array 函数:

If you do need a sub -- note that the documentation refers to using an array of names. For this you can use the Array function:

Sub Ref2Named()
    Dim Nm As Name
    On Error Resume Next
    For Each Nm In ThisWorkbook.Names
        ActiveSheet.Cells.ApplyNames Names:=Array(Nm.Name)
    Next Nm
    On Error GoTo 0
End Sub

我不是 On Error Resume Next 的粉丝，但在这种情况下，我认为这是适当的，因为如果实际上未出现名称， ApplyNames 似乎会失败在该范围内的任何公式中.

I'm not a fan of On Error Resume Next but in this case I think it appropriate since the ApplyNames seems to fail if the name doesn't actually appear in any formula in the range.

如果名称是对其他工作表中范围的引用，则 ApplyNames 的局限性在于它仅使用对当前工作表的引用替换名称.一种解决方法是使用查找并替换":

If the names are references to ranges in other sheets, it seems to be a limitation of ApplyNames that it only replaces names with references to the current sheet. A workaround is to use Find and Replace:

Sub Ref2Named()
    Dim Nm As Name, ref As String
    With ActiveSheet.Cells
        For Each Nm In ThisWorkbook.Names
            On Error Resume Next
                .ApplyNames Names:=Array(Nm.Name)
            On Error GoTo 0
            ref = Nm.RefersTo
            ref = Mid(ref, 2)
            .Replace What:=ref, Replacement:=Nm.Name
            ref = Replace(ref, "$", "")
            .Replace What:=ref, Replacement:=Nm.Name
        Next Nm
    End With
End Sub

例如，如果名称 test 指向 Sheet2！$ A $ 1 ，那么我首先将此引用分配给 ref (剥离后在 RefersTo 中的前导 = 中关闭).然后，如果Sheet1中的任何单元格(假设这是活动工作表)具有 Sheet2！A1 或 Sheet2 $ A $ 1 ，则将其替换为 test .我仍然保留 ApplyNames 作为本地名称.

If, for example, the name test refersto Sheet2!$A$1 then I am first assigning this reference to ref (after stripping off the leading = in RefersTo). Then if any cell in Sheet1 (assuming this is the active sheet) has either Sheet2!A1 or Sheet2$A$1, this will be replaced by test in the formula. I am still keeping the ApplyNames for the local names.

要应用于工作簿中的所有工作表，请尝试:

To apply to all worksheets in the workbook, try:

Sub ApplyAllNames()
    Dim ws As Worksheet, Nm As Name, ref As String
    For Each ws In ThisWorkbook.Worksheets
        With ws.Cells
            For Each Nm In ThisWorkbook.Names
                On Error Resume Next
                    .ApplyNames Names:=Array(Nm.Name)
                On Error GoTo 0
                ref = Nm.RefersTo
                ref = Mid(ref, 2)
                .Replace What:=ref, Replacement:=Nm.Name
                ref = Replace(ref, "$", "")
                .Replace What:=ref, Replacement:=Nm.Name
            Next Nm
        End With
    Next ws
End Sub

例如您的某些名字是列是绝对的，但不是绝对的，因此需要对该代码进行调整.

If some of your names are e.g. column absolute but not absolute, this code would need to be tweaked.

编辑时:这是一个应该能够处理大型电子表格的版本.要使用它，请添加对 Microsoft Scripting Runtime 的引用(在VBA编辑器的 Tools/References 下):

On Here is a version which should be able to handle large spreadsheets. To use it, add a reference to Microsoft Scripting Runtime (under Tools/References in the VBA editor):

Sub ApplyAllNames()
    Dim D As New Dictionary
    Dim C As Collection
    Dim ws As Worksheet, sh As Worksheet
    Dim A As Variant, v As Variant
    Dim nm As Name, i As Long, n As Long, ref As String
    Dim R As Range

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    For Each ws In Worksheets
        Set C = New Collection
        D.Add ws.Name, C
    Next ws
    For Each nm In Names
        ref = Split(nm.RefersTo, "!")(0) '=sheet name of ref
        ref = Mid(ref, 2) 'get rid of "="
        D(ref).Add nm
    Next nm

    'replace each collection of names
    'by an array sorted in order of descending length
    Set sh = Worksheets.Add
    For Each ws In Worksheets
        If ws.Name <> sh.Name Then
            Set C = D(ws.Name)
            n = C.Count
            If n = 0 Then
                D(ws.Name) = Array()
            Else
                ReDim A(1 To n, 1 To 2)
                For i = 1 To n
                    A(i, 1) = C(i).Name
                    A(i, 2) = Len(C(i).RefersTo)
                Next i
                Set R = sh.Range(sh.Cells(1, 1), sh.Cells(n, 2))
                R.Value = A
                R.Sort key1:=Range("B1:B" & n), order1:=xlDescending, Header:=xlNo
                A = R.Value
                D(ws.Name) = A
            End If
        End If
    Next ws
    Application.DisplayAlerts = False
    sh.Delete
    Application.DisplayAlerts = True

    'now loop over sheets and name array
    For Each ws In Sheets
        For Each sh In Sheets
            A = D(sh.Name)
            If ws.Name = sh.Name Then
                On Error Resume Next
                    For i = 1 To UBound(A)
                        ws.Cells.ApplyNames A(i, 1)
                    Next i
                On Error GoTo 0
            Else
                For i = 1 To UBound(A)
                    Set v = Names(A(i, 1))
                    ref = Mid(v.RefersTo, 2) 'name with "=" removed
                    ws.Cells.Replace ref, v.Name
                    ref = Replace(ref, "$", "")
                    ws.Cells.Replace ref, v.Name
                Next i
            End If
            Debug.Print ws.Name & " <- " & sh.Name
            DoEvents
        Next sh
    Next ws
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

代码根据包含名称所指范围的表将名称拆分为多个桩.然后，它以增量方式处理应用程序，并在立即窗口中显示进度指示器.例如， Sheet3<-Sheet5 意味着引用Sheet5的名称已应用于Sheet 3中的公式.已修复了一个细微的错误.某些范围的地址可能是其他范围地址的前缀.较早的代码可能例如在涉及"Sheet2！A55 "的公式中间用名称(例如"foo_bar")替换"Sheet2！A5"，并在单元格中留下"Sheet2！foo_bar5"`.解决方法是按引用长度递减的顺序对名称进行排序.

The code splits the names into piles according to the sheet containing the range that the name refers to. Then it does the application incrementally, with a progress indicator in the immediate window. For example, Sheet3 <- Sheet5 means that names referring to Sheet5 have been applied to formulas in Sheet 3. A subtle bug has been fixed. Some ranges might have addresses which are prefixes of other range address. The earlier code might e.g. replace "Sheet2!A5" in the middle of a formula involving"Sheet2!A55by a name (say "foo_bar") leaving"Sheet2!foo_bar5"` in the cell. The fix was to sort names in the order of decreasing reference length.

我在一个工作簿上尝试了上面的代码，该工作簿有11个工作表，10,000个命名范围和5,000个公式，每一个都引用5个随机选择的单元格，因此需要进行超过20,000个替换.大约需要4分钟.如果此方法不起作用，自然的下一步是使用正则表达式从每个公式中提取单元格引用，并将这些引用与名称引用字典进行比较.

I tried the above code on a workbook with 11 sheets, 10,000 named ranges and 5,000 formulas, each of which refers to 5 randomly chosen cells in such a way that over 20,000 replacements need to be made. It takes about 4 minutes. If this one doesn't work, the natural next step would be to use regular expressions to extract cell references from each formula and comparing these references to a dictionary of name references.

这篇关于用命名范围替换坐标参考的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！