大家帮忙看看，程序运行比较慢，要如何改善

大家帮忙看看，程序运行比较慢，要怎么改善？
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

[解决办法]
不停的find，一般都会很慢
你想干吗啊？也许该用公式直接算，而不要用宏

[解决办法]
加快速度的一种方法： 在程序开头加上关闭刷新 在程序后面再打开
[解决办法]
别用paste，自己编一段代码cells(i,j)=cells(m,n)，会快一点
不要频繁地select，active，而是直接dim shtOBJ=sheets(1),然后调用shtOBJ会更快一点

[解决办法]
将你所要的值先放到一个二维数组里
然后，用二维数组直接对Excel赋值，都不要循环的～！
你现在这样，不停的打开文件，进行赋值，速度肯定很慢了～！
[解决办法]
在你的循环开头和结尾加上以下两句,在修改时不要刷新屏幕:

VB code

Application.ScreenUpdating = FalseApplication.ScreenUpdating = True