vba Excel 范围中的一维数组

One-dimensional array from Excel Range

提问by Felix

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

我目前正在使用以下代码填充我的数组 Securities：

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) 有效地将证券剥离为一维数组（我在每个循环中都陷入困境）。

采纳答案by Patrick Honorez

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

回答by Jon49

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.Transpose(Range("D6:D65541").Value)'runs without error, but Application.Transpose(Range("D6:D65542").Value)'run-time error 13 Type mismatch

Update 2:

更新 2：

Another problem you might have as mentioned in the comments:

您可能在评论中提到的另一个问题：

If one exceeds 255 characters, the function fails.

如果超过 255 个字符，则该功能失败。

It has been a long time since I worked with Excel VBA but this might be a general limitation of accessing the data this way?

自从我使用 Excel VBA 以来已经有很长时间了，但这可能是以这种方式访问​​数据的一般限制？

回答by Alex P

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.

如果您将单列中的值读取到数组中，那么我确实认为您最终会得到一个需要使用array(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

回答by aevanko

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 ReDimto 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).

从范围中获取一维数组的最快方法可能是将范围转储为二维数组并将其转换为一维数组。这是通过声明第二个变体并ReDim在将范围转储到第一个变体中后使用将其重新调整为适当的大小来完成的（请注意，您不需要使用 Array()，您可以按照我上面的方法进行操作，这更清楚）。

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

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

I hope this helps.

我希望这有帮助。

回答by sbitaxi

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.

可以通过嵌套 Split/Join 和 Transpose 从 Range 创建一个 String 数组。我还没有针对循环测试性能，但这绝对是一次通过。

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”），将其转置以将其转换为单维，加入 String 数组，使用 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 GMT

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

使用两种方法进行测试，通过循环写入 Array 和使用 Split/Join/Transpose 100 rows, 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 GMTAdded function TwoDtoOneD function and results

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

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 GMT

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

以下是我用来进行测试的 Sub 和函数

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 GMT

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 指出的那样，我的测试肯定存在缺陷。似乎 Split/Join/Transpose 的 Array 没有超过 16k 行，这仍然低于他指出的 65k 限制。我承认，这对我来说是一个惊喜。我的测试肯定是不完整和有缺陷的。