One-dimensional array from Excel Range

2020-01-26 05:12发布

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

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

标签: excel vba
5条回答
【Aperson】
2楼-- · 2020-01-26 05:41

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

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

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

I hope this helps.

查看更多
啃猪蹄的小仙女
3楼-- · 2020-01-26 05:47
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
查看更多
Explosion°爆炸
4楼-- · 2020-01-26 05:48

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

Update 2:

Another problem you might have as mentioned in the comments:

If one exceeds 255 characters, the function fails.

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?

查看更多
何必那么认真
5楼-- · 2020-01-26 05:54

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.

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
查看更多
淡お忘
6楼-- · 2020-01-26 05:59

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.

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.

EDIT 20160418 15:09 GMT

Test using two methods, writing to Array by loop and using 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

100          0.00    0.00

10000      0.03    0.02

100000    0.35    0.11

1000000  3.29    0.86

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

Rows       Loop   SplitJoinTranspose    TwoDtoOneD

100           0.00     0.00                              0.00

10000       0.03     0.02                              0.01

100000     0.34     0.12                              0.11

1000000   3.46     0.79                              0.81

EDIT 20160420 01:01 GMT

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

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.

查看更多
登录 后发表回答