来自Excel范围的一维数组

I'm presently populating my array Securities with the following code:

我目前正在用以下代码填充我的数组证券:

Option Base 1
Securities = Array(Worksheets(3).Range("A8:A" & SymbolCount).Value)

This produces a 2-dimensional array where every address is (1...1,1...N). I want a 1-dimensional array (1...N).

这产生了一个二维数组，其中每个地址都是(1…1,1…N)。我想要一个一维数组(1…N)

How can I either (a) populate Securities as a 1-dimensional array, or, (b) efficiently strip Securities to a 1-dimensional array (I'm stuck at a with each loop).

如何(a)将证券填充为一维数组，或者(b)有效地将证券剥离为一维数组(每次循环我都被固定在a) ?

5 个解决方案

#1

Sub test2()
    Dim arTmp
    Dim securities()
    Dim counter As Long, i As Long
    arTmp = Range("a1").CurrentRegion
    counter = UBound(arTmp, 1)
    ReDim securities(1 To counter)
    For i = 1 To counter
        securities(i) = arTmp(i, 1)
    Next i
    MsgBox "done"
End Sub

#2

I know you already accepted an answer but here is simpler code for you:

我知道你已经接受了一个答案，但这里有一个更简单的代码:

If you are grabbing a singe row (with multiple columns) then use:

如果您正在抓取一个单列(包含多个列)，则使用:

Securities = application.transpose(application.transpose _
             (Worksheets(3).Range("A8:A" & SymbolCount).Value))

If you are grabbing a single column (with multiple rows) then use:

如果您正在抓取单个列(包含多个行)，则使用:

Securities = application.transpose(Worksheets(3).Range("A8:A" & SymbolCount).Value)

So, basically you just transpose twice for rows and once for columns.

基本上，你只是对行进行两次转置，对列进行一次转置。

Update:

更新:

Large tables might not work for this solution (as noted in the comment below):

大型表可能不适用于此解决方案(如下面的注释所示):

I used this solution in a large table, and I found that there is a limitation to this trick: Application.Transpose(Range("D6:D65541").Value) 'runs without error, but Application.Transpose(Range("D6:D65542").Value) 'run-time error 13 Type mismatch

我在一个大表中使用了这个解决方案，我发现这个技巧有一个局限性:application .转置(Range(D6:D65541).Value)'运行没有错误，但是application .转置(Range(“D6:D65542”).Value“运行时错误13类型不匹配

#3

If you read values from a single column into an array as you have it then I do think you will end up with an array that needs to be accessed using array(1, n) syntax.

如果您将单个列中的值读取到一个数组中，那么我认为您最终将得到一个需要使用数组(1,n)语法访问的数组。

Alternatively, you can loop through all cells in your data and add them into an array:

或者，您可以循环遍历数据中的所有单元，并将它们添加到数组中:

Sub ReadIntoArray()
    Dim myArray(), myData As Range, cl As Range, cnt As Integer, i As Integer
    Set myData = Worksheets(3).Range("A8:A" & SymbolCount) //Not sure how you get SymbolCount

    ReDim myArray(myData.Count)

    cnt = 0
    For Each cl In myData
        myArray(cnt) = cl
        cnt = cnt + 1
    Next cl

    For i = 0 To UBound(myArray) //Print out the values in the array as check...
        Debug.Print myArray(i)
    Next i
End Sub

#4

This will reflect the answer iDevlop gave, but I wanted to give you some additional information on what it does.

这将反映iDevlop给出的答案，但我想给您提供一些关于它的功能的附加信息。

Dim tmpArray As Variant
Dim Securities As Variant

'Dump the range into a 2D array
tmpArray = Sheets(3).Range("A8:A" & symbolcount).Value

'Resize the 1D array
ReDim Securities(1 To UBound(tmpArray, 1))

'Convert 2D to 1D
For i = 1 To UBound(Securities, 1)
    Securities(i) = tmpArray(i, 1)
Next

Probably the fastest way to get a 1D array from a range is to dump the range into a 2D array and convert it to a 1D array. This is done by declaring a second variant and using ReDim to re-size it to the appropriate size once you dump the range into the first variant (note you don't need to use Array(), you can do it as I have above, which is more clear).

从一个范围获取1D数组的最快方法可能是将该范围转储为一个2D数组并将其转换为一个1D数组。这是通过声明第二个变量并使用ReDim将其重新调整为适当的大小来完成的，一旦您将范围转储到第一个变量中(注意，您不需要使用Array()，您可以像我上面所做的那样，这更清楚)。

The you just loop through the 2D array placing each element in the 1D array.

您只需循环遍历2D数组，将每个元素放置在一维数组中。

I hope this helps.

我希望这可以帮助。

#5

It is possible by nesting Split/Join and Transpose to create an array of String from the Range. I haven't yet tested performance against a loop, but it's definitely a single pass.

通过嵌套分割/连接和转置，可以从范围创建字符串数组。我还没有对循环进行性能测试，但肯定是单次测试。

This code takes a Range (my sample was 1 column wide, with 100 rows of "abcdefg"), Transposes it to make convert it to a single dimension, JOINs the String array, using vbTab as a separator, then Splits the joined string on the vbTab.

这段代码接受一个范围(我的示例为1列宽，有100行“abcdefg”)，将它转换为一个维度，使用vbTab作为分隔符加入字符串数组，然后在vbTab上分割加入的字符串。

Sub testStrArr()
Dim arr() As String
arr = Split(Join(Application.Transpose(Range(Cells(1, 1), Cells(100, 1)).Value), vbTab), vbTab)
Debug.Print arr(2)
End Sub

It is limited to string Arrays, as Join and Split are both String functions. Numbers would require manipulation.

它仅限于字符串数组，因为Join和Split都是字符串函数。数量需要操纵。

EDIT 20160418 15:09 GMT

格林尼治时间编辑20160418 15:09

Test using two methods, writing to Array by loop and using Split/Join/Transpose 100 rows, 10k, 100k, 1mil

使用两种方法进行测试，通过循环写入数组并使用Split/Join/转置100行，10k, 100k, 1mil。

Private Function testStrArrByLoop(ByVal lRow As Long)
Dim Arr() As String
Dim i As Long

ReDim Arr(0 To lRow)
For i = 2 To lRow
    Arr(i) = Cells(i, 1).Value
Next i
End Function

Private Function testStrArrFromRng(ByVal lRow As Long)
Dim Arr() As String
Arr = Split(Join(Application.Transpose(Range(Cells(1, 1), Cells(lRow, 1)).Value), vbTab), vbTab)
End Function

Private Function TwoDtoOneD(ByVal lRow As Long)
Dim tmpArr() As Variant
Dim Arr() As String
tmpArr = Range(Cells(2, 1), Cells(lRow, 1)).Value
ReDim Arr(LBound(tmpArr) To UBound(tmpArr))
For i = LBound(tmpArr, 1) To UBound(tmpArr, 1)
    Arr(i) = tmpArr(i, 1)
Next
End Function

Rows       Loop   SplitJoinTranspose

行循环SplitJoinTranspose

100          0.00    0.00

100年0.00 - 0.00

10000      0.03    0.02

10000年0.03 - 0.02

100000    0.35    0.11

100000年0.35 - 0.11

1000000  3.29    0.86

1000000 3.29 - 0.86

EDIT 20160418 15:49 GMT Added function TwoDtoOneD function and results

编辑20160418 15:49 GMT添加函数和结果

Rows       Loop   SplitJoinTranspose    TwoDtoOneD

行循环SplitJoinTranspose TwoDtoOneD

100           0.00     0.00                              0.00

100 0.00 0.00 0.00

10000       0.03     0.02                              0.01

10000 0.03 0.02 0.01

100000     0.34     0.12                              0.11

100000 0.34 0.12 0.11

1000000   3.46     0.79                              0.81

1000000 3.46 0.79 0.81

EDIT 20160420 01:01 GMT

编辑格林尼治时间20160420 01:01

The following are the Sub and function I used to conduct my tests

下面是我用来进行测试的子函数和函数

Sub CallThem()
' This sub initiates each function call, passing it through a code timer.
    Dim iterations(0 To 3) As Long
    Dim i As Integer
    iterations(0) = 100
    iterations(1) = 10000
    iterations(2) = 100000
    iterations(3) = 1000000

    For i = LBound(iterations) To UBound(iterations)
        Range(Cells(2, 1), Cells(iterations(i), 1)).Value = "abcdefg"
        Cells(i + 1, 2).Value = CalculateRunTime_Seconds("testStrArrByLoop", iterations(i))
        Cells(i + 1, 3).Value = CalculateRunTime_Seconds("testStrArrFromRng", iterations(i))
        Cells(i + 1, 4).Value = CalculateRunTime_Seconds("TwoDtoOneD", iterations(i))
        Cells(i + 1, 5).Value = iterations(i)
    Next i
End Sub


Private Function CalculateRunTime_Seconds(fnString As String, iterations As Long) As Double
'PURPOSE: Determine how many seconds it took for code to completely run
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim StartTime As Double
Dim SecondsElapsed As Double

'Remember time when macro starts
  StartTime = Timer

 Result = Application.Run(fnString, iterations)

'Determine how many seconds code took to run
  CalculateRunTime_Seconds = Timer - StartTime

End Function

EDIT 20160420 12:48 GMT

编辑20160420 12:48格林尼治时间

As @chris neilsen indicated, there's definitely a flaw in my tests. Seems the Array for Split/Join/Transpose is not taking more than 16k rows, which is still under the 65k limit he indicated. This, I'll admit, is a surprise to me. My tests were definitely incomplete and flawed.

正如@chris neilsen所指出的，我的测试肯定存在缺陷。似乎拆分/连接/转置的数组不超过16k行，这仍然低于他所指出的65k的限制。我承认，这对我来说是个惊喜。我的测试肯定是不完整和有缺陷的。