动态命名范围的VBA合并导致静态范围i / o保持动态

时间:2018-02-01 18:00:37

标签: excel excel-vba 64-bit vba7 vba

上下文(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

GetDNR函数返回的DNR: enter image description here

1 个答案:

答案 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"