在 VBA 中从范围创建数组

除了提出的解决方案，如果你有一个一维范围到一维阵列，我更喜欢处理它通过一个函数如下。原因很简单: 如果出于任何原因，您的范围减少到1元素范围，据我所知，命令 Range ()。值将不返回变量数组，而只返回变量，您将无法将变量变量赋给变量数组(以前声明过)。

我必须将一个可变大小的范围转换为一个双数组，当范围为1个单元格大小时，我不能使用 range ()这样的构造。值，所以我继续执行下面的函数。

Public Function Rng2Array(inputRange As Range) As Double()


Dim out() As Double
ReDim out(inputRange.Columns.Count - 1)


Dim cell As Range
Dim i As Long
For i = 0 To inputRange.Columns.Count - 1
out(i) = inputRange(1, i + 1) 'loop over a range "row"
Next


Rng2Array = out
End Function

此函数返回一个数组，而与范围的大小无关。

Range 将返回一个数组，除非该范围只有1个单元格，然后它将返回一个值。此函数将单个值转换为数组(基于1，与数组通过范围返回的值相同)

这个答案比以前的答案有所改进，因为无论范围大小如何，它都会返回一个数组。与其他答案相比，它也更有效率，因为如果可能的话，它将返回由范围生成的数组。使用单维和多维数组

函数的工作原理是试图找到数组的上界。如果失败，那么它必须是一个单一的值，所以我们将创建一个数组，并赋值给它。

Public Function RangeToArray(inputRange As Range) As Variant()
Dim size As Integer
Dim inputValue As Variant, outputArray() As Variant


' inputValue will either be an variant array for ranges with more than 1 cell
' or a single variant value for range will only 1 cell
inputValue = inputRange


On Error Resume Next
size = UBound(inputValue)


If Err.Number = 0 Then
RangeToArray = inputValue
Else
On Error GoTo 0
ReDim outputArray(1 To 1, 1 to 1)
outputArray(1,1) = inputValue
RangeToArray = outputArray
End If


On Error GoTo 0


End Function

对于@Vityata 的回答，下面是我用来在一维数组中转换行/列向量的函数:

Function convertVecToArr(ByVal rng As Range) As Variant
'convert two dimension array into a one dimension array
    

Dim arr() As Variant, slicedArr() As Variant
arr = rng.value   'arr = rng works too (https://bettersolutions.com/excel/cells-ranges/vba-working-with-arrays.htm)
    

If UBound(arr, 1) > UBound(arr, 2) Then
slicedArr = Application.WorksheetFunction.Transpose(arr)
Else
slicedArr = Application.WorksheetFunction.index(arr, 1, 0)  'If you set row_num or column_num to 0 (zero), Index returns the array of values for the entire column or row, respectively._
'To use values returned as an array, enter the Index function as an array formula in a horizontal range of cells for a row,_
'and in a vertical range of cells for a column.
'https://usefulgyaan.wordpress.com/2013/06/12/vba-trick-of-the-week-slicing-an-array-without-loop-application-index/
End If
convertVecToArr = slicedArr
End Function

我也赞成迭代范围内的单元格。除非有人找到了变通方法，否则我尝试将范围直接分配给 Variant 的经验是，如果我的范围有多个区域，比如，当我只想要过滤表中的一列中的可见单元格时，或者如果我在一张表中使用 ctrl 选择不同的单元格块，那么它可以很好地工作(尽管当我真的只需要1D 时返回一个二维数组)。

使用 for. . each 循环遍历范围内的所有单元格，始终会产生我所期望的结果。

Public Function RangeToArray(ByRef myRange As Range)
Dim i As Long
Dim individualCell As Range
    

ReDim myArray(myRange.Count - 1)


For Each individualCell In myRange
myArray(i) = individualCell.Text         ' or maybe .Value
i = i + 1
Next
RangeToArray = myArray
    

End Function

我想把这个作为保罗的回答的一个评论，因为它非常相似，但我是一个新手，没有足够的声誉，所以这里有另一个 有点不同的答案。

换位是个很好的建议。 我的应用程序中有多个数组，有些是全局的，有些是本地的，有些是从范围加载的，有些是程序化创建的。

我有许多尺寸的问题。现在，与转置他们都是一个维度。

我确实需要稍微修改一下代码，因为一个版本在 Excel2003上运行，另一个(速度较慢)在2010上运行。

注意: 当你将数组保存到一个范围时，你必须再次转换它。

使用 Range 的形状

另一种为 ArrayFromRange创建函数的方法是使用 Range 的形状和大小来确定我们应该如何构造数组。这样，我们就不必将数据加载到中间数组中来确定维度。

例如，如果目标范围只有一个单元格，那么我们知道要返回一个包含单个值的数组 Array(target.value)。

下面是应该处理所有情况的完整函数。注意，这使用了与使用 Application.Transpose方法重新设置数组形状相同的技术。

' Helper function that returns an array from a range with the
' correct dimensions. This fixes the issue of single values
' not returning as an array, and when a 2 dimension array is returned
' when it only has 1 dimension of data.
'
' @author Robert Todar <robert@roberttodar.com>
Public Function ArrayFromRange(ByVal target As Range) As Variant
Select Case True
' Single cell
Case target.Cells.Count = 1
ArrayFromRange = Array(target.Value)
            

' Single Row
Case target.Rows.Count = 1
ArrayFromRange = Application.Transpose( _
Application.Transpose(target.Value) _
)
        

' Single Column
Case target.Columns.Count = 1
ArrayFromRange = Application.Transpose(target.Value)
            

' Multi dimension array
Case Else
ArrayFromRange = target.Value
End Select
End Function

测试 ArrayFromRange函数

作为额外收获，下面是我运行以检查该函数是否有效的测试。

' @requires {function} ArrayDimensionLength
' @requires {function} ArrayCount
Private Sub testArrayFromRange()
' Setup a new workbook/worksheet for
' adding testing data
Dim testWorkbook As Workbook
Set testWorkbook = Workbooks.Add
Dim ws As Worksheet
Set ws = testWorkbook.Worksheets(1)
    

' Add sample data for testing.
ws.Range("A1:A2") = Application.Transpose(Array("A1", "A2"))
ws.Range("B1:B2") = Application.Transpose(Array("B1", "B2"))
    

' This section will run all the tests.
Dim x As Variant
    

' Single cell
x = ArrayFromRange(ws.Range("A1"))
Debug.Assert ArrayDimensionLength(x) = 1
Debug.Assert ArrayCount(x) = 1
    

' Single Row
x = ArrayFromRange(ws.Range("A1:B1"))
Debug.Assert ArrayDimensionLength(x) = 1
Debug.Assert ArrayCount(x) = 2
    

' Single Column
x = ArrayFromRange(ws.Range("A1:A2"))
Debug.Assert ArrayDimensionLength(x) = 1
Debug.Assert ArrayCount(x) = 2
    

' Multi Column
x = ArrayFromRange(ws.Range("A1:B2"))
Debug.Assert ArrayDimensionLength(x) = 2
Debug.Assert ArrayCount(x) = 4
    

' Cleanup testing environment
testWorkbook.Close False
    

' Print result
Debug.Print "testArrayFromRange: PASS"
End Sub

辅助函数用于测试

在我的测试中，我使用了两个助手函数: ArrayCount和 ArrayDimensionLength。

' Returns the length of the dimension of an array
'
' @author Robert Todar <robert@roberttodar.com>
Public Function ArrayDimensionLength(sourceArray As Variant) As Integer
On Error GoTo catch
Do
Dim currentDimension As Long
currentDimension = currentDimension + 1
        

' `test` is used to see when the
' Ubound throws an error. It is unused
' on purpose.
Dim test As Long
test = UBound(sourceArray, currentDimension)
Loop
catch:
' Need to subtract one because the last
' one errored out.
ArrayDimensionLength = currentDimension - 1
End Function

' Get count of elements in an array regardless of
' the option base. This Looks purely at the size
' of the array, not the contents within them such as
' empty elements.
'
' @author Robert Todar <robert@roberttodar.com>
' @requires {function} ArrayDimensionLength
Public Function ArrayCount(ByVal sourceArray As Variant) As Long
Dim dimensions As Long
dimensions = ArrayDimensionLength(sourceArray)
    

Select Case dimensions
Case 0
ArrayCount = 0
        

Case 1
ArrayCount = (UBound(sourceArray, 1) - LBound(sourceArray, 1)) + 1
        

Case Else
' Need to set arrayCount to 1 otherwise the
' loop will keep multiplying by zero for each
' iteration
ArrayCount = 1
           

Dim dimension As Long
For dimension = 1 To dimensions
ArrayCount = ArrayCount * _
((UBound(sourceArray, dimension) - LBound(sourceArray, dimension)) + 1)
Next
End Select
End Function