Question

我正在尝试将一些非连续的列（比如列A，列C，列E）复制到动态数组中。但是，在使用VBA Application.Union方法时，似乎只复制了连续范围，留下了非连续范围。

我曾尝试复制连续的列（A，B，C，D，E），这些列按预期工作，但不连续的列（A，C，E）没有。

任何人都可以帮我吗？感谢。

Sub TestFunction()

    Dim TempArray() As Variant
    Dim rngUnion As Range
    With ThisWorkbook.Worksheets(2)
        Set rngUnion = Application.Union(.Range("A1:A10"), .Range("C1:C10"), .Range("E1:E10"))
    End With

    TempArray = rngUnion
End Sub

Answer 1

你没有提到你在使用阵列做什么，所以我不确定这是否适合你。但是，为什么不直接使用rngUnion而不是数组，并根据需要循环遍历其Areas集合？

例如，这个函数：

Sub TestFunction2()
    Dim rngUnion As Range
    Dim area As Range
    With ThisWorkbook.Worksheets(2)
        Set rngUnion = Application.Union(.Range("A1:A10"), .Range("C1:C10"), .Range("E1:E10"))
    End With

    For Each area In rngUnion.Areas
        Debug.Print area.Address
    Next area

    Set area = Nothing
    Set rngUnion = Nothing
End Sub

返回此输出：

$A$1:$A$10
$C$1:$C$10
$E$1:$E$10

如果您确实需要该数组，则可以使用相同的循环将单个Areas（即Ranges）添加到数组中。

Answer 2

蒂姆威廉姆斯已经回答了你的问题。我只是想展示一种从多个非连续范围创建数组的很酷的方法。这项工作的关键是所有范围都有1列和相同的行数。

getArrayFromRanges获取传递给它的每个范围的值数组，并使用Transpose将其从2D数组转换为1D数组。这些1D Temp阵列中的每一个都被添加到1D数据阵列中。然后使用转置将数据从1D阵列1D阵列转换为2D阵列。

Sub TestFunction()
    Dim Data
    With Worksheets(2)
        Data = getArrayFromRanges(.Range("A1:A10"), .Range("C1:C10"), .Range("E1:E10"))
        .Range("A12").Resize(UBound(Data, 1), UBound(Data, 2)) = Data
    End With
End Sub

Function getArrayFromRanges(ParamArray Sources())
    Dim Data, Temp, v
    Dim x As Long
    ReDim Data(UBound(Sources))

    For Each v In Sources
        Temp = Application.Transpose(v)
        Data(x) = Temp
        x = x + 1
    Next

    getArrayFromRanges = Application.Transpose(Data)

End Function

来自Contextures Excel Sample Data

的示例数据

Excel VBA - 无法选择多个非连续列范围

2 个答案: