Excel VBA：比较大循环中日期的有效方法

Question

计划说明

我正在尝试使用Sub来从许多文件中进行raport。每个文件都包含按日期排序的行，并且没有固定数量的这些行。有些只有300个，有些则超过10 000个。每一行都分为模块，描述了一些问题的出现，每个模块中都有所有列的总和。 Raport应该在用户设置的某些文件中显示用户设置的某些模块出现的问题。

的问题

我的子作品，但我不确定我是否正确地做到了。对于一个文件操作需要大约6秒，但是对于所有文件操作有时将近2分钟（在最大循环中每个文件5000个循环），这是非常长的。我几乎可以肯定有更有效的方法来完成这项工作。我想，主要的问题是我在每行检查日期的方式 - 它也是最长的循环。经过一番阅读：

• http://www.ozgrid.com/VBA/VBALoops.htm
• What is the most efficient/quickest way to loop through rows in VBA (excel)?

我真的不明白如何在这里申请f.e. 过滤或查找函数，我也尝试使用 Arrays 和 Foreach ，但时间执行几乎相同（有时更好，有时不更好。另外我认为很多 If的和嵌套循环可能会减慢 Sub 的速度。也许在Excel VBA中有一些并行循环或线程使用来加速它？我认为Excel总是只使用25％的进程。此外，我试图给用户一点机会配置循环范围（ Number1 和 Number2 代码）将时间从2分钟减少到30分钟设置良好的秒数，但需要不时检查和清理DataBase文件，因此它不是最佳解决方案。

我刚开始编程，这是我的第一个大项目，所以我知道代码质量不好，我希望你可以指导我一点，让这个龟更快。很抱歉很长的帖子。

代码

它非常大，所以我删除了一些不那么重要的和平（它被描述）。

Sub CopyInfo()
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Application.EnableEvents = False
   Sheets("Silnik").Select

   'Cleaning cells for raporting (they need to be empty)
    Call Czyść

   'Variable for storing data value
    Dim Value

   'Timer - to see how long it takes
    Dim t As Single
    t = Timer

   'Variables for opening and closing scope of checking data (editable by the user)
    Dim Data1, Data2
    Data1 = Cells(3, 9).Value
    Data2 = Cells(4, 9).Value

   'Position of cells in raport can change (P - row, P2 - column), easy edit
    Dim Postion, Position2
    Position = 9
    Position2 = 13

   'With row should I start looking (N1)? How many rows should I look for dates (N2)?
   'Get search scope values from sheet (these cells are editable by the user)
    Dim Number1, Number2
    Number1 = ActiveWorkbook.Sheets("Silnik").Cells(2, 28)
    Number2 = ActiveWorkbook.Sheets("Silnik").Cells(3, 28)

   'With files should I test? Do I need to test all of them, or just few (LiniaStany)
   'Check state of the file (user can edit with file hes testing)
   'Also - get names of the files (LiniaNazwy) - they can change in time
    Dim LiniaStany(16), LiniaNazwy(16)
    For i = 0 To 15
       LiniaStany(i) = ActiveWorkbook.Sheets("Silnik").Cells(2 + i, 22)
       LiniaNazwy(i) = ActiveWorkbook.Sheets("Silnik").Cells(2 + i, 21)
    Next

   'Variables for workbooks
    Dim wb As Workbook, wb2 As Workbook
    Dim vFile As Variant
   'Set current workbook (to this file)
    Set wb = ActiveWorkbook


   'Core
   'i means currently opened file
    For i = 0 To 15
       'Check if file should be tested, if yes, then set FilePath and open
       If (LiniaStany(i) > 0) Then
          vFile = "C:\Users\Kris\Desktop\kontrol " & LiniaNazwy(i) & " M.xlsm"
          Workbooks.Open vFile
         'Set DataBase workbook
          Set wb2 = ActiveWorkbook
         'Number is currently tested row in chosen file
          For Number = Number1 To Number2
             Value = wb2.Worksheets("Baza").Cells(6 + Number, 1)
             'Check if date is in the scope
             If (Value >= Data1) And (Value <= Data2) Then
                'Get information about SUM of problems in "module1"
                 wb.Sheets("Wyniki").Cells(Position - 1, 4 + i * 3) = wb.Sheets("Wyniki").Cells(Position - 1, 4 + i * 3) + wb2.Worksheets("Baza").Cells(6 + Number, 80)
                 'Check if problems>0, if yes, get more informations
                  If (wb2.Worksheets("Baza").Cells(6 + Number, 80).Value > 0) Then
                      For WK = 0 To 17
                          wb.Sheets("Wyniki").Cells(Position + WK, 4 + i * 3).Value = wb.Sheets("Wyniki").Cells(Position + WK, 4 + i * 3).Value + wb2.Worksheets("Baza").Cells(6 + Number, Position2 + WK).Value
                      Next WK
                  End If
                 'Get information about SUM of problems in "module2"
                  wb.Sheets("Wyniki").Cells(Position + 18, 4 + i * 3) = wb.Sheets("Wyniki").Cells(Position + 18, 4 + i * 3) + wb2.Worksheets("Baza").Cells(6 + Number, 82)
                  If (wb2.Worksheets("Baza").Cells(6 + Number, 82).Value > 0) Then
                      For ZAP = 0 To 9
                         'ZAP - Detale
                          wb.Sheets("Wyniki").Cells(Position + ZAP + 18, 4 + i * 3).Value = wb.Sheets("Wyniki").Cells(Position + ZAP + 18, 4 + i * 3).Value + wb2.Worksheets("Baza").Cells(6 + Number, Position2 + ZAP + 17).Value
                      Next ZAP
                  End If
                  'Some more ifs (7)..., same way, cut out
                  '...
                  '...
            End If
            'See if row is empty or not - if yes, stop the main loop
            If (Value < 1) Then
                Exit For
            End If
        Next Number
        'Close DataBase workbook, go to another one
        wb2.Close False
    End If
Next

Sheets("Raport").Select
Application.ScreenUpdating = screenUpdateState
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = eventsState

Beep
MsgBox "Operation time: " & Timer - t & " seconds."

End Sub

Answer 1

正如我在一段时间后发现的那样，没有必要在循环中比较这样的日期。 从不。 Excel提供过滤器，可用于将细胞范围仅减少到这些过滤器，这些过滤器中描述了符合某些条件的过滤器。最简单的方法是打开宏录制器并在单元格区域上设置过滤器。代码应如下所示（在注入dateStart和dateEnd之后）：

With Sheet1

            .AutoFilterMode = False

            .Range("A1:D1").AutoFilter

            .Range("A1:D1").AutoFilter Field:=2, Criteria1:=">=dateStart", _

             Operator:=xlAnd, Criteria2:="<=dateEnd"

    End With

但是，如果我们使用此过滤器遍历范围，我们仍然会得到相同的结果。为了提高效率，我们只需要使用可见（过滤）的单元格。为此，我们可以使用特殊单元格：

Set rng = Range("A2:D50")

For Each cl In rng.SpecialCells(xlCellTypeVisible)
    'Do something on cells in date range
Next cl

使用此方法替换外部循环后，可以从不同的列中过滤掉其他选项（添加具有不同字段和条件的不同过滤器）。通过这种方式，无需使用 for循环。使用这种方法可以将时间从几分钟缩短到几秒。