将坐标引用replace为命名范围
我有一个大约有10,000个命名范围和22个工作表的巨大xlsm文件。 我需要将公式中的坐标引用replace为相应的命名范围。 我已经试过这个脚本：
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找不到任何引用来replace。
首先，整个代码可能被单行代替：
ActiveSheet.Cells.ApplyNames
根本没有要求。 该文档将name参数描述为“要应用的名称的数组，如果省略此参数，则表上的所有名称都将应用于该范围。 但是 – 目前尚不清楚这将适用于工作簿名称集合中的每个名称。
如果你确实需要一个子注释，那么这个文档引用了一个名称数组 。 为此，您可以使用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一个限制，它只会用当前工作表的引用replace名称。 解决方法是使用查找和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的leading =之后）。 然后，如果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
如果你的一些名字是例如绝对列，但不是绝对的，这个代码将需要调整。
在编辑：这是一个应该能够处理大型电子表格的版本。 要使用它，请添加对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的名称已应用于Sheet 3中的公式。修复了一个微妙的错误。 一些范围可能具有其他范围地址的前缀的地址。 较早的代码可能会"Sheet2!A5" in the middle of a formula involving “Sheet2！A55” "Sheet2!A5" in the middle of a formula involvingreplace"Sheet2!A5" in the middle of a formula involving在单元格中by a name (say "foo_bar") leaving “Sheet2！foo_bar5”减less参考长度的顺序。
我在一张工作簿上试了上面的代码，其中有11个工作表，10,000个命名范围和5,000个公式，每个工作簿都指向5个随机select的单元格，以便需要进行2万多次replace。 大约需要4分钟。 如果这不起作用，下一步的自然步骤是使用正则expression式从每个公式中提取单元格引用，并将这些引用与名称引用的字典进行比较。