Excel VBA：在大循环中比较日期的有效方法 程序描述

我正在试着用很多文件制作饶舌音乐。每个文件都由按日期排序的行组成，并且没有固定的行数。有的只有300英镑，有的超过10000英镑。每一行被划分为模块，描述了一些出现的问题，并且每个模块中有所有列的总和。 Raport应说明在用户设置的时间内，在用户检查的特定文件中，特定模块出现了多少问题

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

我真的不知道如何在这里应用f.e.过滤器或查找函数，我也在尝试使用数组和Foreach，但时间执行几乎是一样的，有时更好，有时不是。我还认为许多If和嵌套循环可能会减慢Sub的速度。Excel VBA中可能有一些并行循环或线程使用来加速它？我认为Excel总是只使用25%的Processor。另外，我尝试给用户一点机会，在代码中配置循环作用域Number1和Number2，通过良好的设置，将时间从2分钟缩短到30秒，但数据库文件需要不时检查和清理，因此这不是最佳解决方案

我刚刚开始编程，这是我的第一个大项目，所以我意识到代码质量很差，我希望你们能给我一些指导，让这只乌龟更快。抱歉发了这么长的邮件

密码 它相当大，所以我删除了一些不太重要的和平，它的描述

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

---

正如我在一段时间后发现的，没有必要在循环中比较这样的日期。从不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

---

使用此方法替换外部循环后，可以从不同的列中筛选出其他选项，添加具有不同字段和条件的不同过滤器。这样，根本不需要使用for循环。使用这种方法可以将时间从几分钟减少到几秒钟。

代码看起来相当不错。2分钟对15个文件来说是合理的，不是吗？VBA不支持线程。那么，你的实际问题是什么？好吧，如果是的话，那就没事了。正如我所说，这是我的第一个更大的项目，我很好奇是否有其他更快的方法来实现这一点。谢谢你的回复。

Set rng = Range("A2:D50")

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