在 For...Next 循环中创建动态大小的数组

Question

我有价格数据，每天记录多个但数量不定的价格。在另一张纸上，我有一个所有单独日期的列向量。在每一天旁边，我需要一个包含当天所有价格的行向量。

我认为最好的方法是每天复制价格并将它们放入一个数组中，我可以将其粘贴并转置到另一张表中。为此，我创建了两个循环，但我不知道如何存储每一天的价格并在我通过循环时为每一天填充这个动态大小的数组。我想我必须在每个循环中重新调整数组，但是当我通过循环时如何填充数组的每个元素？

这是我所在位置的副本。

Sub GroupDayData()

    Dim RowCount As Integer
    Dim RowCount2 As Integer
    Dim r As Integer
    Dim j As Integer
    Dim Day As Date
    Dim No1 As Worksheet
    Dim No2 As Worksheet
    Dim TradePrice() As Double

    No1 = Worksheets("Sheet1")
    No2 = Worksheets("Sheet4")

    RowCount = Application.CountA(No1.Range("A:A"))
    RowCount2 = Application.CountA(No2.Range("A:A"))

    Application.ScreenUpdating = False

    'First I want to set the particular day I am looking at
    For r = 1 To RowCount2 + 1
    Day = Range("A" & r)
        'I then want to look at all values on that day
        For j = 1 To RowCount + 1
            If No1.Range("A" & j) = Day Then
            'This is where I am stuck. I want the code to populate an array as it runs through
            'this second loop, which I will paste and transpose in Sheet4, and then do the whole
            'thing again for the next day, therefore the size of the array is not constant.

    Application.ScreenUpdating = True

End Sub

在 cmets 之后，我已经编辑了代码，但是我仍然没有得到任何输出出现在 Sheet 2 (No2) 中。问题似乎是有效地填充数组，并将其粘贴到选定的范围内。

Sub DayData()

    Dim RowCount As Integer
    Dim ClmnCount As Integer
    Dim r As Integer
    Dim j As Integer
    Dim No1 As Worksheet
    Dim No2 As Worksheet
    Dim Day As Date
    Dim Price() As Variant
    'Does this need to be declared as Double?
    Dim e As Integer

    Set No1 = Worksheets("Sheet1")
    Set No2 = Worksheets("Sheet2")

    RowCount = No1.Application.CountA(No1.Range("A:A")) + 1
    ClmnCount = No2.Cells(1, Columns.Count).End(xlToLeft).Column

    Application.ScreenUpdating = False

    For r = 1 To ClmnCount
        Day = No2.Cells(1, r)

        For j = 1 To RowCount
            If No1.Range("A" & j).Offset(1, 0) = Day Then
            'This loop will look through all date values and count the number that are the same
            e = e + 1
            'First I need to count how many elements are in the particular array
            ReDim Preserve Price(e)
            'Redim the array with its size
            'Is there a more efficient way rather than using redim each loop
            Price(e) = Range("B" & j).Offset(1, 0).Value
            'I think the problem is here
            End If
        Next j

        No2.Range(Cells(2, r), Cells(e + 1, r)) = Price
        Erase TradePrice

    Next r

    Application.ScreenUpdating = False

End Sub

Answer 1

共有三种可能的方法。根据情况，我使用选项 1 或 2。我几乎从不使用 3。

1。提前数数

循环一次以计算数组需要包含多少元素。他们 Dim 相应的数组。然后再次循环以填充数组。

优点：不必猜测数组大小。立即获取元素计数，无论如何您可能在其他地方都需要它。

缺点：循环两次 = 对性能的影响很小。可读性稍差。

2。做好最坏的打算

Dim 数组，以便它可以容纳最大数量的元素（在您的情况下，这大概是(RowCount2 + 1) * (RowCount + 1)）。然后循环填充它，跟踪写入了多少元素。最后，使用Redim Preserve 将其修剪到确切数量的元素。

专业版：只循环一次；最佳性能。

Con：数组太大而无法开始；只有内存有问题时才有问题。

3。边走边补

循环填充数组，每次向数组添加元素时使用Redim Preserve调整数组大小。

专业版：可以说是最易读的。

骗局：反复调用Redim Preserve 会严重减慢速度，因为 VBA 必须反复寻找新的 RAM 空间。这就是为什么我从不这样做。

Answer 2

在 VBA 中，您可以动态调整数组的大小

Redim Preserve TradePrice(newSize)

TradePrice(LastElement) = theNewValue

Answer 3

我按照 Jean-Francois Corbett 的第一种方法，对我的问题提出了以下解决方案：

选项显式

选项基础 1

子 DayData()

Dim RowCount As Integer
Dim ClmnCount As Integer
Dim r As Integer
Dim j As Integer
Dim No1 As Worksheet
Dim No2 As Worksheet
Dim Day As Date
Dim Price() As Double
'Difference between a variant as array and an array of variants
Dim e As Integer

Set No1 = Worksheets("Sheet1")
Set No2 = Worksheets("Sheet2")

RowCount = No1.Application.CountA(No1.Range("A:A"))
ClmnCount = No2.Cells(1, Columns.Count).End(xlToLeft).Column

Application.ScreenUpdating = False

For r = 1 To ClmnCount
    Day = No2.Cells(1, r)
    e = 0

    For j = 1 To RowCount
        If No1.Range("A" & j).Offset(1, 0) = Day Then
        'This loop will look through all date values and count the number that are the same
        e = e + 1
        'First I need to count how many elements are in the particular array
        ReDim Preserve Price(e)
        'Redim the array with its size
        Price(e) = No1.Range("B" & j).Offset(1, 0).Value
        End If
    Next j

    e = e + 1
    No2.Range(Cells(2, r), Cells(e, r)).Value = Application.Transpose(TradePrice)
    'This is where I went wrong, first I needed to transpose my array, and second,
    'given I was starting from row 2, I need to add 1 to e, as well as include
    'Option Base 1

    Erase Price

Next r

Application.ScreenUpdating = False

结束子