Question

我有一个巨大的xlsm文件，大约有10,000个命名范围和22个工作表。我需要将公式中的坐标引用替换为相应的命名范围。我试过这个剧本：

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无法找到任何替换引用。

Answer 1

首先，整个代码可能会被单行代替：

ActiveSheet.Cells.ApplyNames

根本不需要sub。 documentation将name参数描述为＆＃34;要应用的名称数组。如果省略此参数，则工作表上的所有名称都将应用于范围。＆＃34;但是 - 并不清楚这将适用于工作簿的名称集合中的每个名称。

如果您确实需要一个子注释，文档指的是使用名称的数组。为此，您可以使用Array功能：

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似乎失败，如果名称实际上没有出现在范围。

如果名称是对其他工作表中范围的引用，则ApplyNames的限制似乎只是用当前工作表的引用替换名称。解决方法是使用查找和替换：

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为本地名称。

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

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

如果您的某些名字是，例如列绝对但不是绝对的，这段代码需要调整。

On Edit：这是一个应该能够处理大型电子表格的版本。要使用它，请添加对Microsoft Scripting Runtime的引用（在VBA编辑器中的Tools/References下）：

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的名称已应用于工作表3中的公式。已修复了一个微妙的错误。某些范围可能具有其他范围地址的前缀的地址。较早的代码可能例如在单元格中替换"Sheet2!A5" in the middle of a formula involving＆＃34; Sheet2！A55 by a name (say "foo_bar") leaving＆＃34; Sheet2！foo_bar5＆＃34;`修复是按照参考长度递减的顺序排序名称。

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

用命名范围替换坐标引用

1 个答案: