用命名范围替换坐标参考 [英] 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 公式中的code>.我仍然保留
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屋!