[求助]我的代码太复杂，运行太慢，请大侠帮忙优化。

SYSMEX530

Sub 写入多工作簿()
    Dim mypath$, myfile$, AK As Workbook, aRow%, tRow%, i As Integer, sht As Worksheet, rt, J As Long
    Application.ScreenUpdating = False
    mypath = ThisWorkbook.Path & "\"
       myfile = Dir(mypath & "*.xls")
       Do While myfile <> ""
          If myfile <> ThisWorkbook.Name Then
             Set AK = Workbooks.Open(mypath & myfile)
              Application.DisplayAlerts = False
                For Each sht In Worksheets
                If sht.Name Like "*(*上下*)" Then sht.Activate
                Next
                Application.DisplayAlerts = True
                  rt = ActiveSheet.Range("R65536").End(xlUp).Row
                  For J = rt To 7 Step -1
                  If Range("i" & J) >= 1.06 Then
                  Rows(J).Delete
                  End If


                  Next J
             Select Case ActiveSheet.[A9].CurrentRegion.Rows.Count
             Case Is > 50
             lr = Range("a65536").End(xlUp).Row + 1
             mr = Range("U65536").End(xlUp).Row
        Workbooks("数据2015.9.2").Sheets(2).Range("I7:Q" & mr).Copy
             ActiveSheet.Range("I7:Q" & mr).Select
             ActiveSheet.Paste
        Workbooks("数据2015.9.2").Sheets(2).Range("V7:AD" & mr).Copy
             ActiveSheet.Range("V7:AD" & mr).Select
             ActiveSheet.Paste
        Workbooks("数据2015.9.2").Sheets(2).Range("A391:AL473").Copy
             ActiveSheet.Range("A" & lr).Select
             ActiveSheet.Paste
        ActiveSheet.Range("b65536").End(xlUp).Offset(-61, 0).Resize(1, 3).Copy
             ActiveSheet.[e5:g5].Select
             ActiveSheet.Paste
             Selection.PasteSpecial Paste:=xlPasteValues
        ActiveSheet.Range("b65536").End(xlUp).Offset(-61, 23).Resize(1, 3).Copy
             ActiveSheet.[e6:g6].Select
             ActiveSheet.Paste
             Selection.PasteSpecial Paste:=xlPasteValues
        ActiveSheet.Range("b65536").End(xlUp).Offset(-60, 0).Resize(1, 3).Copy
             ActiveSheet.[I5:K5].Select
             ActiveSheet.Paste
             Selection.PasteSpecial Paste:=xlPasteValues
             ActiveSheet.Cells.Columns("A:A").ColumnWidth = 13
             ActiveSheet.Cells.Columns("B:AD").ColumnWidth = 6.18
             Workbooks(myfile).Close True
             ActiveWorkbook.Save
             Case Is < 50
        Workbooks("数据2015.9.2").Sheets(3).Range("A20:BA230").Copy
             ActiveSheet.Range("A20:BA230").Select
             ActiveSheet.Paste
             Workbooks(myfile).Close True
             ActiveWorkbook.Save
             End Select
           End If
          myfile = Dir
       Loop
   Application.ScreenUpdating = True
   MsgBox "数据更新完毕！", 164, "提示"
End Sub

Ronaldo09

上文件 不然没人看

SYSMEX530

Ronaldo09 发表于 2015-11-2 22:48
上文件 不然没人看

【新提醒】Excel 跪求各位大侠，我的代码太啰嗦，运行太慢，请帮忙优化-ExcelVBA程序开发-ExcelHome技术论坛 -
http://club.excelhome.net/thread-1239709-1-1.html

Ronaldo09

SYSMEX530 发表于 2015-11-5 09:46
【新提醒】Excel 跪求各位大侠，我的代码太啰嗦，运行太慢，请帮忙优化-ExcelVBA程序开发-ExcelHome技术 ...

没有源文件，没看懂啥。应该可以到数组里面循环更快。另外workbooks.open 可以改为 GetObject更快。建议你上修改后的一个源文件，把里面数据改掉，这样更好