EXCEL VBA 早く処理をする
よろしくお願いします
下の構文を標準モジュールに書き込み、callで実行しているのですが
処理に時間がかかります。
処理を早くする方法と構文の簡素化のご教示をお願いします。
Application.ScreenUpdating = False
For i = 1 To 12
With Worksheets(i)
.Select
LastRow = .Range("A150").End(xlUp).Row + 1
.Range("A8:G" & LastRow).Sort Key1:=Range("A8"), order1:=xlAscending
.Range("G8:G" & LastRow - 1).Formula = "=G7+E8-F8"
LastRow = .Range("A150").End(xlUp).Row + 1
.Range("A" & LastRow).Select
Dim EndRow As Long
EndRow = .Range("A" & Rows.Count).End(xlUp).Row
Cells(Rows.Count, 1).End(xlUp).Offset(1, 3) = .Name & "合計"
Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) = Application.WorksheetFunction.Sum(Range("E7:E" & EndRow))
Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) = Application.WorksheetFunction.Sum(Range("F7:F" & EndRow))
Cells(Rows.Count, 1).End(xlUp).Offset(2, 3) = "前月繰越"
Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) = .Range("G7")
Cells(Rows.Count, 1).End(xlUp).Offset(2, 5) = ""
Cells(Rows.Count, 1).End(xlUp).Offset(3, 4) = ""
Cells(Rows.Count, 1).End(xlUp).Offset(3, 3) = "次月繰越"
Cells(Rows.Count, 1).End(xlUp).Offset(4, 3) = "合計"
Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) - Cells(Rows.Count, 1).End(xlUp).Offset(1, 5)
Cells(Rows.Count, 1).End(xlUp).Offset(4, 4) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4)
Cells(Rows.Count, 1).End(xlUp).Offset(4, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 5)
Cells(Rows.Count, 1).End(xlUp).Offset(1, 6) = ""
Cells(Rows.Count, 1).End(xlUp).Offset(2, 6) = ""
Cells(Rows.Count, 1).End(xlUp).Offset(3, 6) = ""
Cells(Rows.Count, 1).End(xlUp).Offset(4, 6) = Cells(Rows.Count, 1).End(xlUp).Offset(0, 6)
.Range("C7").End(xlDown).Select
Selection.Offset(4, 2).Borders(xlEdgeTop).Weight = xlHairline
Selection.Offset(4, 2).Borders(xlEdgeBottom).LineStyle = xlDouble
Selection.Offset(4, 3).Borders(xlEdgeTop).Weight = xlHairline
Selection.Offset(4, 3).Borders(xlEdgeBottom).LineStyle = xlDouble
Selection.Offset(4, 4).Borders(xlEdgeTop).Weight = xlHairline
Selection.Offset(4, 4).Borders(xlEdgeBottom).LineStyle = xlDouble
Selection.Offset(0, 2).Borders(xlEdgeTop).Weight = xlHairline
Selection.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Offset(0, 2).Borders(xlEdgeBottom).Weight = xlThin
Selection.Offset(0, 3).Borders(xlEdgeTop).Weight = xlHairline
Selection.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Offset(0, 3).Borders(xlEdgeBottom).Weight = xlThin
Selection.Offset(0, 4).Borders(xlEdgeTop).Weight = xlHairline
Selection.Offset(0, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Offset(0, 4).Borders(xlEdgeBottom).Weight = xlThin
End With
Next i
Application.ScreenUpdating = True
補足
回答ありがとうございます。 ですが、下記で行ってもエラーが出てしまいます。。。 With Sheets("非対象") For Each CRR In .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row) If CRR = TG Then Serc = .Cells(CRR.Row, 2) Chacktuke = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Find(Serc).Row Cells(Chacktuke, 36) = 0 End If Next End With 対象となるセルを探し当て、そのセルの３６列目に数字の「０」を入れたい のを手間を無くす為にFind使いましたが、大人しくFor Eachで検索をした 方が良いですかね。。。(-_-;)