时间戳

首页 > 解决方案 > 堆栈空间不足 - 如何优化 VBA 代码

excel - 堆栈空间不足 - 如何优化 VBA 代码

问题描述

我正在编写一个代码来检索（有点）大型 Excel 电子表格（2,000 个条目）中的特定日期。我只是意识到我的代码不起作用，而且只会变得更糟。你能告诉我吗。

我给我的功能：

该代码将无法使用 5,000 行的数据库，因为如果日期位于表的末尾，则必须将其堆叠。我能做些什么来解决这个问题？

非常感谢你

Function looping(array() As Variant, FirstDate As Date, DateSave() As Long)

    Dim i As Long
    Dim PositionInArray As Long

    PositionInArray = 0
    
    For i = LBound(array, 1) To UBound(array, 1)
        
                If array(i, 1) = FirstDate Then

                    ReDim Preserve DateSave(PositionInArray)
                    DateSave(PositionInArray) = i
                    PositionInArray = PositionInArray + 1

                End If
            
                'If end of list and array not initialize ie. Not value in it
                If i = UBound(array, 1) And (Not DateSave) = -1 Then

                    Call looping(array(), FirstDate + 1, DateSave())

                ElseIf i = UBound(array, 1) Then

                    'Array has been initialized
                    Exit For

                End If

            Next i

End Function

编辑：将数据库更改为 excel 电子表格

标签： excelvba

解决方案

我已经重命名了函数和参数。该函数返回结果而不是具有ByRef参数。我使用了一个集合来存储行索引。

Function GetDatePositions(ByRef database() As Variant, ByVal searchDate As Date) As Long()
    Const colDates As Long = 1 'the index of the column holding dates
    Dim i As Long
    Dim collRowIndexes As New Collection
    
    For i = LBound(database, 1) To UBound(database, 1)
        If database(i, colDates) = searchDate Then
            collRowIndexes.Add i
        End If
    Next i
    
    If collRowIndexes.Count = 0 Then
        GetDatePositions = GetDatePositions(database, searchDate + 1)
        Exit Function
    End If
    
    Dim res() As Long
    ReDim res(0 To collRowIndexes.Count - 1)
    Dim v As Variant
    
    i = 0
    For Each v In collRowIndexes
        res(i) = v
        i = i + 1
    Next v
    
    GetDatePositions = res
End Function

编辑

无需搜索每个连续的日期。我们只需要跟踪大于搜索日期的下一个日期。

Function GetDatePositions(ByRef database() As Variant, ByVal searchDate As Date) As Long()
    Const colDates As Long = 1 'the index of the column holding dates
    Dim i As Long
    Dim collRowIndexes As New Collection
    Dim dateFound As Boolean
    Dim nextDate As Date
    Dim tempDate As Date
    
    dateFound = False
    For i = LBound(database, 1) To UBound(database, 1)
        tempDate = database(i, colDates)
        If tempDate = searchDate Then
            dateFound = True
            collRowIndexes.Add i
        Else
            If Not dateFound Then
                If searchDate < tempDate Then
                    If nextDate = 0 Then
                        nextDate = tempDate
                    ElseIf tempDate < nextDate Then
                        nextDate = tempDate
                    End If
                End If
            End If
        End If
    Next i
    '
    If collRowIndexes.Count = 0 Then
        If nextDate = 0 Then
            Err.Raise 5, "GetDatePositions", "No date found"
        Else
            GetDatePositions = GetDatePositions(database, nextDate)
            Exit Function
        End If
    End If
    
    Dim res() As Long
    ReDim res(0 To collRowIndexes.Count - 1)
    Dim v As Variant
    
    i = 0
    For Each v In collRowIndexes
        res(i) = v
        i = i + 1
    Next v
    
    GetDatePositions = res
End Function

显然，假设所有日期都是四舍五入的。但如果日期还包含时间（小时、分钟、秒），则tempDate = database(i, colDates)需要替换为tempDate = VBA.Int(database(i, colDates))

推荐阅读