Question

我现在使用以下代码填充我的阵列证券：

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

这会生成一个二维数组，其中每个地址都是（1 ... 1,1 ... N）。我想要一个1维数组（1 ... N）。

我如何（a）将证券作为一维数组填充，或者（b）有效地将证券剥离为一维数组（我在每个循环中陷入困境）。

Answer 1

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

如果你抓住一个单行（有多列），那么使用：

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

如果要抓取单个列（包含多行），请使用：

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

所以，基本上你只需要两次换行，一次用于列。

<强>更新

大型表可能不适用于此解决方案（如下面的评论中所述）：

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

Answer 2

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

Answer 3

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

Answer 4

这将反映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（），您可以这样做正如我上面所说，这更清楚了）。

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

我希望这会有所帮助。

Answer 5

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

此代码采用Range（我的样本为1列宽，100行“abcdefg”），将其转换为将其转换为单个维度，使用vbTab作为分隔符加入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

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

编辑20160418 15:09 GMT

使用两种方法测试，通过循环写入Array并使用Split / Join / Transpose 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

3.29百万0.86

EDIT 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

3.46百万0.79 0.81

EDIT 20160420 01:01 GMT

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

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

Excel Range的一维数组

5 个答案: