Excel范围内的一维数组

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

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

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

我怎样才能(a)将证券作为一维数组填充,或者(b)有效地将证券剥离到一个一维数组(我被困在每一个循环中)。

 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 

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

如果您正在抓取单行(多列),请使用:

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

如果您要抓取一列(多行),请使用:

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

所以,基本上你只需要对行进行两次转置,对列进行一次转置。

更新:

大型表格可能无法用于此解决scheme(如下面的注释中所述):

我在一个大的表中使用了这个解决scheme,我发现这个技巧是有限制的: Application.Transpose(Range("D6:D65541").Value) '运行没有错误,但是Application.Transpose(Range("D6:D65542").Value)运行时错误13types不匹配

如果你从一列读取数据到一个数组中,那么我确实认为你最终会得到一个需要使用array(1, n)语法访问的array(1, n)

或者,您可以遍历数据中的所有单元格,并将其添加到数组中:

 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 

这将反映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 

从一个范围内获得一维数组的最快方法是将范围转储到二维数组中并将其转换为一维数组。 这是通过声明第二个变体并使用ReDim在将范围转储到第一个变体中时将其重新调整为适当的大小来完成的(注意,您不需要使用Array(),您可以像上面那样做,这更清楚)。

你只是通过二维数组放置每个元素在一维数组中。

我希望这有帮助。

可以通过嵌套Split / Join和Transpose来从Range中创build一个String数组。 我还没有testing一个循环的性能,但它绝对是一次通过。

这段代码需要一个范围(我的示例是1列宽,有100行“abcdefg”),将其转换为单维,使用vbTab作为分隔符连接string数组,然后将连接的string拆分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 

它仅限于string数组,因为Join和Split都是string函数。 数字将需要操纵。

编辑20160418 15:09 GMT

使用两种方法进行testing,按循环写入数组,并使用拆分/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 

行循环SplitJoinTranspose

100 0.00 0.00

10000 0.03 0.02

100000 0.35 0.11

1000000 3.29 0.86

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

行循环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

编辑20160420 01:01 GMT

以下是我用来进行testing的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 

编辑20160420 12:48 GMT

正如@chris neilsen所指出的那样,我的testing中肯定存在缺陷。 似乎Split / Join / Transpose的数组没有超过16k行,这仍然低于他指出的65k的限制。 我承认,这对我来说是一个惊喜。 我的testing肯定是不完整的和有缺陷的。