プログラムの説明
私は多くの人からraportsを作るためにSubをやろうとしていますファイル。すべてのファイルは日付順に並べられた行で構成されており、これらの固定数はありません。 300しかないものもあれば、10000を超えるものもあります。すべての行はモジュールに分割されており、いくつかの問題の出現について説明しています。また、すべてのモジュールにすべての列の合計があります。 Raportは、特定のモジュールからの問題の数を、ユーザーが設定した時間の経過とともに、ユーザーがチェックした特定のファイルに表示する必要があります。
問題
私のサブは動作しますが、私がそれをやっているかどうかはわかりません正しく。 1つのファイルの操作には約6秒かかりますが、すべての場合、2分近く（最大のループではファイルごとに5000ループ）で、非常に長くなります。仕事を行うためのより効率的な方法があるとほぼ確信しています。 。主な問題は、すべての行の日付をチェックする方法です。これは最長のループでもあります。いくつか読んだ後：
ここでの申し込み方法がよくわかりません。 フィルタ または 検索 関数、また私が試していた 配列 そして フォアハ、しかし時間の実行はほぼ同じでした（時にはより良い、時にはそうではない）。また、多くの人が もしそうなら ネストされたループは遅くなる可能性があります サブ ダウン。多分いくつかあります 並列ループ または スレッドの使用 それをスピードアップするためにExcelVBAで？ Excelは常にプロセッサの25％しか使用しないと思います。また、ユーザーにループスコープを構成する機会を少し与えようとしています（Number1 そして 2番 に コード）適切に設定すると、時間が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:UsersKrisDesktopkontrol " & 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
回答：
回答№1は0しばらくしてわかったので、日付を比較する必要はありません このような ループ中。 決して。 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ループ。この方法で時間を短縮することが可能です 分から数秒まで。