Redim Preserve 2D 数组答案

【问题标题】：Redim Preserve 2D arrayRedim Preserve 2D 数组
【发布时间】：2014-05-12 13:46:24
【问题描述】：

我有一些代码，它从范围中获取值并将它们放入一个数组中。所以我有 1,000,000 行和 4 列。

x= Range("A1:D1000000").value

ReDim Arr(0 To UBound(x, 1), 0 To 4)

for i = 1 to 10
  for y = 1 to 4
    Arr(i - 1, y-1 ) = x(i, y)
  next y
next i

ReDim Preserve ARR(i)

Listbox1.list = Arr

我试过了

ReDim Preserve ARR(i)
ReDim Preserve ARR(i,4)
ReDim Preserve ARR(1,i)

如果没有 Redim Preserve，我会得到所有 1.000.000 的结果和空白

如何将保留的大小调整为 i 大小，以便我只得到 10 个结果？

【问题讨论】：

有几种方法可以做到这一点，但一个问题是您只能调整多维数组的 last 维度。
正确的大小应该是ReDim Arr(1 To UBound(x, 1), 1 To 4)

标签： arrays vba excel

【解决方案1】：

您将不得不稍微重构您的代码。您只能调整多维数组的 last 维度。

除非有令人信服的理由，否则我可能会做的就是简单地调整您正在使用的 Range 对象的大小。这比尝试调整数组大小更容易。

Sub Test()
Dim x As Variant, ARR As Variant
Dim i As Integer
Dim y As Integer

Dim rng As Range  'Declare a range object we will use later

' Assign to our range object
Set rng = Range("A1:D1000000") 

'Resize your range object, it is easier to do this than to resize an array
Set rng = rng.Resize(10, 4)

'Now, your array x will take on the desired size of the range
'assign the rng.Value to array "x"
x = rng.Value

'And the array ARR will also take on this property based on x.
ReDim ARR(0 To UBound(x, 1), 0 To 4)

For i = 1 To 10
  For y = 1 To 4
    ARR(i - 1, y - 1) = x(i, y)
  Next y
Next i

End Sub

更新

如果您需要保持 Range 对象的尺寸，则可以改为这样做，这将使 x 成为适当大小的数组，无需调整范围对象本身的大小。

' Assign to our range object
    Set rng = Range("A1:D1000000") 

'Use the resize method when assigning to array "x":
x = rng.Resize(10, 4).Value

【讨论】：

感谢您的回答，但我需要动态调整大小，所以“for i = 1 to DynamicValue”
好吧，你的问题并不太清楚，在这种情况下，另一个接受的答案将是我所说的“重组你的代码”。干杯。

【解决方案2】：

x= Range("A1:D1000000").value

ReDim Arr( 0 To 4 , 0 To UBound(x, 1))

for i = 1 to 10
  for y = 1 to 4
    Arr( y-1, i - 1 ) = x(i, y)
  next y
next i

ReDim Preserve ARR(0 to 4, 0 to i)

而不是：

Listbox1.List = Arr

你应该使用：

Listbox1.column = Arr

【讨论】：

【解决方案3】：

不要读取所有百万行。找到包含数据的范围的最后一行，然后只将这些数据带入。

Sub FillLb()

    Dim vaRange As Variant
    Dim aList() As Variant
    Dim i As Long, j As Long
    Dim rLastCell As Range

    Sheet1.ListBox1.Clear

    'Find the last cell that has something ("*") in it by searching
    'backward from A1 using xlPrevious
    Set rLastCell = Sheet1.Range("A1:D1000000").Find("*", Sheet1.Range("A1"), xlValues, , , xlPrevious)

    'Only read in up to the last value
    vaRange = Sheet1.Range("A1", rLastCell).Value
    ReDim aList(0 To UBound(vaRange, 1) - 1, 0 To UBound(vaRange, 2) - 1)
    Sheet1.ListBox1.ColumnCount = UBound(vaRange, 2)

    For i = LBound(vaRange, 1) To UBound(vaRange, 1)
        For j = LBound(vaRange, 2) To UBound(vaRange, 2)
            aList(i - 1, j - 1) = vaRange(i, j)
        Next j
    Next i

    Sheet1.ListBox1.List = aList

End Sub

【讨论】：