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的示例。

我假设日期被格式化为日期并且在第一列中，并且您希望将其与作为td参数的长期函数进行比较。所以我在测试行中添加了符合条件的行：If DateValue(iday_data(1, jColumn)) = td Then
由于您只使用4列，因此我将范围读入限制为以L结尾。
我首先遍历行和列，因为您只能重新绘制外部维度。您将需要第1列的匹配行数，因此我使用Transpose切换了这些行，然后在最后ReDim Preserve之后再次将它们切换回来。使用Transpose行排名有一些限制。
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

无法从另一个阵列分配新的变体数组

1 个答案: