arrays - 无法从另一个数组分配新的变体数组

Question

我正在尝试读取具有以下数据的范围:

date&time    price1 price2 price3 price4 

很多行可以追溯到几个月/几年(每天多个条目)。在第一种情况下，我试图将其作为电子表格中的范围读取，将其加载到变量数组中，然后循环遍历数组，仅选择特定日期的数据。一旦我有了它(我称之为 today_data )，我将对其进行更多计算。现在，我已经定义了新数组( today_data 为 variant )，Excel VBA 不允许我从更大的数组中为其赋值。我是新手，请告诉我我做错了什么？这是代码:

Function test1(td As Long) As Variant

Dim rg As Range
Dim n, m As Long
Dim i, j, k As Long


'intra day data is an n by m array
'i and j are counters for the loops
'td is today's date from the spreadsheet

Dim iday_data As Variant    ' this is the full array of intra-day data
Dim today_data As Variant   ' this is today's intra-day data


    Set rg = ThisWorkbook.Worksheets("Sheet1").Range("i7:m3201")
    iday_data = rg
    n = UBound(iday_data, 1)
    m = UBound(iday_data, 2)
    k = 1


For i = 1 To n

        today_data(k, 1) = iday_data(i, 1)    'this is where the program halts
        today_data(k, 2) = iday_data(i, 2)
        today_data(k, 3) = iday_data(i, 3)
        today_data(k, 4) = iday_data(i, 4)
        k = k + 1

Next i

test1 = today_data

Answer 1

这是一个使用 ReDim Preserve 的示例.

我假设日期被格式化为日期并且在 I 列中，并且您想将其与作为 td 的长期传递函数进行比较争论。所以我在测试行中添加了符合条件的行:If DateValue(iday_data(1, jColumn)) = td Then

由于您只使用 4 列，我将读入范围限制为 L。

我首先交换行和列，因为您只能重新调整外部尺寸。您将需要第 1 列的匹配行数，所以我用 Transpose 切换了这些行数然后在 ReDim Preserve 之后再次将它们换回来在最后。使用 Transpose 进行行 ount 有一些限制.

43267是“16/06/2018”，格式“dd-mm-yyyy”，作为数值传入，即用于日期比较的 td 参数，它需要 Long .

代码:

Option Explicit
Public Sub Testing()
    Dim arr()
    arr = test1(43267)
    Stop

End Sub

Public Function test1(ByVal td As Long) As Variant
    Dim targetRange As Range, numberOfRows As Long, numberOfColumns As Long
    Dim iRow As Long, jColumn As Long, columnCounter As Long
    Dim iday_data(), today_data()

    Set targetRange = ThisWorkbook.Worksheets("Sheet1").Range("I7:L3201") 'Assume L not M as you only work with 4 columns.
    iday_data = targetRange
    iday_data = Application.WorksheetFunction.Transpose(iday_data) 'swop rows and columns
    numberOfRows = UBound(iday_data, 1)
    numberOfColumns = UBound(iday_data, 2)

    ReDim today_data(1 To numberOfRows, 1 To numberOfColumns)

    For iRow = LBound(iday_data, 1) To UBound(iday_data, 1) 'loop between Bounds
        columnCounter = 1
        For jColumn = LBound(iday_data, 2) To UBound(iday_data, 2)
            'Note date value assume Date format in sheet and you want to compare against long passed into function as td argument
            '<== Add in your date/day of interest. Compare against which ever column of iday_data has the day of interest in e.g. 1.
            If DateValue(iday_data(1, jColumn)) = td Then
                today_data(iRow, columnCounter) = iday_data(iRow, jColumn)
                columnCounter = columnCounter + 1
            End If
        Next
    Next

    ReDim Preserve today_data(1 To numberOfRows, 1 To columnCounter)
    today_data = Application.WorksheetFunction.Transpose(today_data) 'swop rows and columns
    test1 = today_data
End Function