Question

我记得我的一个朋友告诉我，循环遍历整个数据库以满足条件是不好的做法（程序员的常见错误），但你引用它们。但是，我知道如何做我想要的唯一方法是使用For-Next循环，If-Then-End If语句并使用Cut和Paste宏来删除旧数据点，并使用Filter宏仅在每次运行代码时过滤感兴趣的日期。

我需要一种更快的方式，因为我使用excel VBA创建了一个完全自动化的工资单程序，该程序将在几年内运行100,000或更多行，甚至只有6000行，此时程序需要大约5分钟才能完成筛选所有条件和计算。

1。）使用For-Next循环和If-Then-End If循环

让：

Total_Rows_InSheet是Test工作表

中的总行数

ActiveDate_Start是我想要仅计算的日期

代码逻辑：

For i = 2 To Total_Rows_InSheet
    If Worksheets("Test").Cells(i, 2) >= ActiveDate_Start Then
        'run code'
    End If
Next i

2。）使用剪切/粘贴宏传输数据，以获取应存档在另一个工作表中的日期，然后计算的行数将始终为活动行。

我想将“有效”数据限制在我的工资单应用程序的特定日期范围内，并且我计划从重新计算中删除已经向员工发出工资单的数据行。这是因为重新运行这些数据毫无意义，因为它会使程序变得非常慢。

3。）类似于＃2，只需使用Filter宏来过滤大于或等于ActiveDate_Start的日期

Answer 1

假设我们在A列中有一些按升序排序的日期（如果没有排序则不起作用！）：

1   2015-01-01
2   2015-01-02
3   2015-01-03
4   2015-01-04
5   2016-12-30
6   2016-12-31
7   2017-01-01
8   2017-01-02
9   2017-01-03
10  2017-01-04
11  2017-01-05
12  2017-01-06
13  2017-01-07
14  2018-01-01
15  2018-01-02
16  2018-01-03
17  2018-01-04
18  2018-01-05

您的相关数据介于2017-01-01和2018-01-01之间，您可以使用

Dim StartRow As Long
StartRow = Application.WorksheetFunction.Match("2017-01-01", Range("A:A").Value, 1)

Dim EndRow As Long
EndRow = Application.WorksheetFunction.Match("2018-01-01", Range("A:A").Value, 1)

Debug.Print StartRow, EndRow

找到循环的第一行和最后一行。

For i = StartRow To EndRow
    If Worksheets("Test").Cells(i, 2) >= ActiveDate_Start Then
        'run code'
    End If
Next i

请注意，您可能需要对Match函数进行一些错误处理，因为它们在找不到任何内容时会抛出错误。

示例：

Dim StartRow As Long
StartRow = 2 'fallback if match throws error
On Error Resume Next 'catch error of match
StartRow = Application.WorksheetFunction.Match("2014-01-01", Range("A:A").Value, 1)
On Error GoTo 0 're-activate error reporting

Answer 2

您可以使用

1）自动过滤 - 这是一种快速有效的方式

2）将所有内容读入数组并在那里执行条件检查。这可能是一个例子。

Option Explicit
Public Sub SubSetArray()
    Dim i As Long, ActiveDate_Start As Long, arr(), outputArr(), counter As Long, j As Long '< or appropriate type
    ActiveDate_Start = 43269 'today's date as a number
    With Worksheets("Test")
        arr = .UsedRange.Value
        ReDim outputArr(1 To UBound(arr, 1), 1 To UBound(arr, 2))
        For i = 2 To UBound(arr, 1)
            If CLng(arr(i, 2)) >= ActiveDate_Start Then 'assumes date format in sheet so converts to Long
                counter = counter + 1
                For j = 1 To UBound(arr, 2)
                    outputArr(counter, j) = arr(i, j)
                Next j
            End If
        Next i
    End With
    outputArr = Application.WorksheetFunction.Transpose(outputArr)
    ReDim outputArr(1 To UBound(outputArr, 1), 1 To counter)
    outputArr = Application.WorksheetFunction.Transpose(outputArr)
    Dim targetRange As Range
    Set targetRange = Worksheets("OutputSheet").Range("A1")
    targetRange.Resize(UBound(outputArr, 1), UBound(outputArr, 2)).Value = outputArr
End Sub

在VBA excel中不查看旧数据的最有效的程序逻辑是什么？

2 个答案: