Excel VBAについて
Excel VBAについて教えて頂きたいのですが、
Sub test()
Dim lastrow, r, i As Long
Dim sh1, sh2 As String
Dim ws As Worksheet
lastrow = Cells(Rows.count, "D").End(xlUp).row
For r = 7 To lastrow '7
For i = 1 To lastrow '4
sh1 = ActiveSheet.Cells(r, 4)
ActiveSheet.Cells(r, 20) = _
Application.CountIfs(Sheets(sh1).Range("D:D"), Range("H3") & Range("I3"), Sheets(sh1).Range("K:K"), "<=3") _
/ Application.CountIf(Sheets(sh1).Range("D:D"), Range("H3") & Range("I3"))
ActiveSheet.Cells(r, 21) = _
Application.CountIfs(Sheets(sh1).Range("C:C"), Range("F3"), Sheets(sh1).Range("K:K"), "<=3") _
/ Application.CountIf(Sheets(sh1).Range("C:C"), Range("F3"))
ActiveSheet.Cells(r, 22) = _
Application.CountIfs(Sheets(sh1).Range("E:E"), Range("K3"), Sheets(sh1).Range("K:K"), "<=3") _
/ Application.CountIf(Sheets(sh1).Range("E:E"), Range("K3"))
Sheets(sh1).Range("A3:R3").AutoFilter Field:=4, Criteria1:=Range("H3") & Range("I3")
ActiveSheet.Cells(r, 15) = Application.Subtotal(105, Sheets(sh1).Range("O:O"))
Sheets(sh1).Range("A3:R3").AutoFilter Field:=4, Criteria1:=Range("H3") & Range("I3") - 200
ActiveSheet.Cells(r, 18) = Application.Subtotal(105, Sheets(sh1).Range("O:O"))
Sheets(sh1).Range("A3:R3").AutoFilter Field:=4, Criteria1:=Range("H3") & Range("I3") + 200
ActiveSheet.Cells(r, 19) = Application.Subtotal(105, Sheets(sh1).Range("O:O"))
For Each ws In Worksheets
ws.AutoFilterMode = False
Next
Next
Next
End Sub
このコードは
ActiveSheetで実行すると
D列の7行目から最終行までに入力されている名前のシート（名前＝シートがあります）
その、シートの参照先で
C,D,E列がcountif関数を利用して
O列がSubtotal関数を利用しています。
このコードでもやりやいことは実行できるのですが、
時間がかかりすぎてしまいます。
約20件あり約２分ほどかかります。パソコンによっては倍ほど時間がかかるかもです。
そこでなのですが、
もっと処理のスピードを上げたいのですが、
可能でしょうか？
可能ならそのやり方をご教示ください。
よろしくお願い致します。
