程序运行比较慢,要怎么改善?
Set ws1 = Workbooks("1.xls").Worksheets("sheet1")
Set ws2 = Workbooks("1.xls").Worksheets("sheet2")
Set ws3 = Workbooks("1.xls").Worksheets("sheet3")
Set ws4 = Workbooks("1.xls").Worksheets("sheet4")
ws1.Select
For i = 4 To ActiveSheet.UsedRange.Rows.Count
If ws1.Cells(i, 8) <> 0 Then
ws1.Select
str = Range("H" & i)
Range(i & ":" & i).Copy
ws3.Select
Cells(ActiveSheet.UsedRange.Rows.Count + 2, 1).Select
ActiveSheet.Paste
With ws3.Range("H" & ActiveSheet.UsedRange.Rows.Count)
.Font.ColorIndex = 3
End With
ws4.Select
Range("DB2:IV2").Select
Set rng = Selection.Find(What:=str, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False)
ws2.Select
For j = 4 To ActiveSheet.UsedRange.Rows.Count
ws2.Select
str1 = ws2.Cells(j, 3).Value
ws4.Select
Range("C82:C" & ActiveSheet.UsedRange.Rows.Count).Select
Set rng1 = Selection.Find(What:=str1, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False)
If Not rng1 Is Nothing Then
If ws4.Cells(rng1.Row, rng.Column) <> "" Then
Windows("2.xls").Activate
ws2.Select
Range(j & ":" & j).Copy
Windows("2.xls").Activate
ws3.Select
Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1).Select
ActiveSheet.Paste
End If
End If
Next
End If
Next
[解决办法]
用数组吧。不然也加上
application.screenupdating = false
application.calculation = xlmanual
application.calculation = xlautomatic
application.screenupdating = true
[解决办法]
1)code本身:包括XLS对象选择语句调用,for,if结构优化;
2)操作多个excel文件时加Application.ScreenUpdating = False屏蔽切换文件时屏闪;
3)执行程序时,关闭编辑器.
[解决办法]
1.用with
2.不要用activesheet,直接用workbook.sheets(i)
3.如可能,不用select
4.不用Range 改用数组
[解决办法]
不要在循环里边操作宏
尤其是双层循环