用单个循环填充二维数组

时间:2019-03-09 23:42:31

标签: excel vba

我尝试下面的代码在Excel VBA中填充二维数组,并且能够获得所需的结果。我想知道是否有更好的方法可以做到这一点,或者一旦在实际情况下我拥有大量数据,您是否会预见到任何技术问题。任何想法或建议都将得到改进。

Sub test_selection()
' My below array is based on values contained within
' selected cells
' The purpose of using two dimensional array is to 
' keep values in one column of array 
' while retaining cell addresses in 2nd 
' dimension to print some info in relevant cells
' offset to the selected cells

Dim anArray() As String

firstRow = Selection.Range("A1").Row
LastRow = Selection.Rows(Selection.Rows.Count).Row
colum = Selection.Columns.Column
arrSize = LastRow - firstRow

ReDim anArray(0 To arrSize, 1)
cnt = 0

For i = firstRow To LastRow
    anArray(cnt, 0) = CStr(Cells(i, colum).Value2)
    anArray(cnt, 1) = Cells(i, colum).Address
    cnt = cnt + 1
Next i

Call TestGetFileList(anArray)

End Sub

1 个答案:

答案 0 :(得分:1)

当您有大量数据时,整个工作表的循环将会很慢。一次捕获所有数据并在内存中对其进行重新处理可能更好。

Option Explicit

Sub test_selection()
' My below array is based on values contained within
' selected cells
' The purpose of using two dimensional array is to
' keep values in one column of array
' while retaining cell addresses in 2nd
' dimension to print some info in relevant cells
' offset to the selected cells

    Dim i As Long, r As Long, c As String, anArray As Variant

    With Selection
        c = Split(.Cells(1).Address, "$")(1)
        r = Split(.Cells(1).Address, "$")(2) - 1
        anArray = .Columns(1).Cells.Resize(.Rows.Count, 2).Value2
    End With

    For i = LBound(anArray, 1) To UBound(anArray, 1)
        anArray(i, 1) = CStr(anArray(i, 1))
        anArray(i, 2) = "$" & c & "$" & i + r
    Next i

    TestGetFileList anArray

End Sub