Question

我努力了解为什么我的代码无法正常工作，尽管重复了两次完全相同的做法，我仍在努力工作：

这适用于一组命名范围：

Dim MyArr() As Variant
Dim RangeName As Variant
RangeName = Array("oneNamedRange", "anotherNamedRange", "onemoreNamedRange")
MyArr = Union(Range(RangeName(0)), Range(RangeName(1)), Range(RangeName(2)))

现在，如果我尝试获取另一个数据集，如：

Dim MyProcess() As Variant
RangeName = Array("nr1", "nr2", "nr3", "nr4", "nr5", "nr6", "nr7")
MyProcess = Range(RangeName(0)) ' Ok
MyProcess = Range(RangeName(1)) ' Ok
MyProcess = Range(RangeName(2)) ' Ok
MyProcess = Range(RangeName(3)) ' Ok
MyProcess = Range(RangeName(4)) ' Ok
MyProcess = Range(RangeName(5)) ' Ok
MyProcess = Range(RangeName(6)) ' Ok

MyProcess = Union(Range(RangeName(0)), Range(RangeName(1))) ' Ok, got my 2D array
MyProcess = Union(Range(RangeName(0)), Range(RangeName(2))) ' NOK
MyProcess = Union(Range(RangeName(0)), Range(RangeName(3))) ' NOK
MyProcess = Union(Range(RangeName(0)), Range(RangeName(4))) ' NOK
MyProcess = Union(Range(RangeName(0)), Range(RangeName(5))) ' NOK
MyProcess = Union(Range(RangeName(0)), Range(RangeName(6))) ' NOK

MyProcess = Union(Range(RangeName(0)), Range(RangeName(0)), Range(RangeName(0))) ' NOK gives only 1D
MyProcess = Union(Range(RangeName(1)), Range(RangeName(1)), Range(RangeName(1))) ' NOK gives only 1D
MyProcess = Union(Range(RangeName(0)), Range(RangeName(1)), Range(RangeName(1))) ' NOK gives only 2D out of 3
MyProcess = Union(Range(RangeName(0)), Range(RangeName(1)), Range(RangeName(2))) ' NOK gives only 2D out of 3

看起来Union或Application.union在VBA中运行奇怪。我还检查了命名范围（大小，名称..），但找不到任何线索。

我可以找到任何好的子程序来设置命名范围的数组，在任何提供范围的情况下工作吗？

Answer 1

以下是我解决问题的方法：

Private Function dBToArray(ByVal NamedRanges As Variant, Optional ByVal oSht As Worksheet = Nothing)

    Dim I As Long
    Dim J As Long
    Dim NbData As Long
    Dim NbRanges  As Long
    Dim MyValue As Variant
    Dim MyArray() As Variant

    ' ---------------
    ' CHECK ARGS
    ' ---------------
    If IsMissing(oSht) Then
        MsgBox "info : Parameter arg not passed"
    End If

    If oSht Is Nothing Then
         Set oSht = ActiveWorkbook.Sheets("dB")
    End If

    If ws_exists(oSht.Name) = False Then
        MsgBox "WS Non Exists"
        Exit Function
    End If

    NbData = Range(NamedRanges(0)).Count ' e.g. ID_process count
    NbRanges = UBound(NamedRanges)
    ReDim MyArray(1 To NbData, 1 To NbRanges) As Variant

    ' Parse the dB ranges
    For I = 1 To NbData
         For J = 1 To NbRanges
             MyValue = oSht.Range(NamedRanges(J - 1)).Value
             ' Debug.Print Chr(10) & Time & " - I: " & I & "," & "J: " & J & ", Val = " & MyValue(I, 1)
              MyArray(I, J) = MyValue(I, 1)
         Next J
     Next I



    ' Return the multiDim array
    dBToArray = MyArray

    ' Free some mem
    Set MyValue = Nothing
    Erase MyArray

End Function

用法

Dim RangeName As Variant
Dim MyArrayFromdBSheet() As Variant

RangeName = Array("ID", "PROCESS_NAME", "PROCESS_CPY", "PROCESS_START", "PROCESS_END")
MyArrayFromdBSheet = dBToArray(RangeName)

Excel VBA - 作为命名范围的并集的数组：奇怪的行为

1 个答案: