上下文(VBA7.1,Excel 2013 Pro):
所有工作表和动态命名范围(DNR)都是以编程方式创建的。我想将一些DNR单元(多个列上相同数据的情况)合并到一个DNR中,以便将它们全部分组。在此阶段,单位DNR及其合并结果都在工作表范围内。
问题:
合并的命名范围不保留所有单个DNR的动态属性。如果我手动完成,它当然是有效的,只是为了确认要合并的DNR是有效动态的。
问题:
我应该如何应用命名范围合并,以便结果范围也保持为动态命名范围?
主要代码
Sub xx()
... some code goes here ...
Dim DNRnames() As String
Dim MergedRange As Range
Dim currentRng As Range
Dim rngStr As Variant
Dim strStringToExclude() As String
' Get created DNRs on this sheet
strStringToExclude = Split("_Desc,Headers", ",")
DNRnames = DNRGetNames(aWS.Name, False, strStringToExclude)
' Merge DNRs into 1
For Each rngStr In DNRnames
' Set currentRng = aWS.Names(CStr(rngStr)).RefersToRange
Set currentRng = aWS.Range(CStr(rngStr)) ' also this way keeps it static
If Not MergedRange Is Nothing Then
Set MergedRange = Union(MergedRange, currentRng)
Else
Set MergedRange = currentRng
End If
Next rngStr
' Add "MergedRange" to the aWS : ISSUE : the MergeRange is NOT dynamic...
' as it would be if I would create it in the ws by a named_range=(range1,range2,..)
aWS.Names.Add Name:=DNRprefix & "All", RefersTo:=MergedRange
...
end sub
GetDNR :将工作表中的命名范围作为字符串数组返回,并排除一些我不想要合并的选定命名范围(因为我找到了,所以它是一种解决方法" Union"但没有" Substract" VBA中的功能)
Function DNRGetNames(sheetName As String, WbScope As Boolean, SuffixStringToExclude() As String) As String() ' all DNR from one specific sheet (with wb scope or ws scope ?)
' https://stackoverflow.com/questions/12663879/adding-values-to-variable-array-vba
' https://stackoverflow.com/questions/4029975/excel-listing-named-range-in-a-worksheet-and-get-the-value
' kind of getter and setter
Dim wb As Workbook
Dim aWS As Worksheet
Dim element As Name
ReDim DNRArray(1 To 1) As String
Set wb = ThisWorkbook
Set aWS = wb.Sheets(sheetName)
' if SuffixStringToExclude is not defined, fill in the suffic string with a default fake data
If Not Len(Join(SuffixStringToExclude)) > 0 Then
SuffixStringToExclude = Split("*FaKe!")
End If
' populate a dynamic array with DNR related to aWS
For Each element In wb.Names
If Not ArrayIsInString(element.Name, SuffixStringToExclude) Then '
If IsNameRefertoSheet(aWS, element) Then
DNRArray(UBound(DNRArray)) = element.Name
ReDim Preserve DNRArray(1 To UBound(DNRArray) + 1) As String
End If
End If
Next element
' clean exit
If UBound(DNRArray) > 1 Then
ReDim Preserve DNRArray(1 To UBound(DNRArray) - 1) As String
DNRGetNames = DNRArray
Else
DNRGetNames = Empty
End If
End Function
答案 0 :(得分:1)
RefersTo
必须是A1 style notation字符串(例如"=A1,B2"
):
Set MergedRange = aWS.Range(Join(DNRnames, ","))
aWS.Names.Add DNRprefix & "All", "=" & MergedRange.Address
Range.Address
限制为255个字符,因此可能需要在合并范围之前创建。
对于工作簿范围命名范围:
MergedRange.Name = DNRprefix & "All"