優化緩慢的VBA代碼

我有以下代碼 - 其中大部分是用宏記錄器記錄的。它很慢，似乎有點不可靠（有時需要大約1分鐘，其他時間需要更長的時間）。優化緩慢的VBA代碼

我想知道如果在這裏任何人都可以幫我打掃一下，並得到它更有效地運行。

謝謝！

Sub RemainingMIUL() 

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 
Application.EnableEvents = False 

    Sheets("Sheet2").Select 

    Columns("A:A").Select 
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 

    Sheets("Sheet1").Select 

    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear 
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _ 
     ("L1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
     xlSortTextAsNumbers 
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort 
     .Header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 

    Columns("L:L").Select 
    Selection.Copy 

    Sheets("Sheet2").Select 
    Range("A1").Select 
    ActiveSheet.Paste 

    Sheets("Sheet1").Select 

    Application.CutCopyMode = False 
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear 
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _ 
     ("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
     xlSortTextAsNumbers 
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort 
     .Header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 

    Sheets("Sheet2").Select 
    Range("B2").Select 

    Dim cell As Range 

    For Each cell In Range("B2", Cells(Rows.Count, "B").End(xlUp)) 
     If Range("A:A").Find(What:=cell.Value2, LookAt:=xlWhole) Is Nothing Then cell.Interior.Color = vbYellow 
    Next cell 

    With Sheets("Sheet2") 
     For Each cell In .Range("B2", Cells(Rows.Count, "B").End(xlUp)) 
      If .Range("A:A").Find(What:=cell.Value2, LookAt:=xlWhole) Is Nothing Then _ 
      Intersect(.UsedRange, cell.EntireRow).Offset(, 1).Copy _ 
      Sheets("Sheet1").Cells(Rows.Count, "L").End(xlUp).Offset(1) 
     Next cell 
    End With 


Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 
Application.EnableEvents = True 

End Sub

來源

2017-01-31 CC268

還沒有來得及看看這個正確的，但你似乎是通過在B列的細胞中循環兩次，所以你也許可以做的代碼更改顏色和代碼在同一個循環內複製。將cell.Interior.Color = vbYellow放在複製代碼下，並在下面添加End If。然後刪除第一個For Each ... Next Cell代碼。在此期間嘗試一下。我相信會有人給你的代碼提供全面的治療。 – Gordon

如果它是一個工作代碼，你只需要優化它然後發佈到[代碼評論]（http://codereview.stackexchange.com/） – user3598756

試着在代碼底部結合2個for循環。當滿足相同的條件時，它們都循環遍歷B列並運行代碼。

With Sheets("Sheet2") 
    For Each cell In .Range("B2", Cells(Rows.Count, "B").End(xlUp)) 
     If .Range("A:A").Find(What:=cell.Value2, LookAt:=xlWhole) Is Nothing Then 
      Intersect(.UsedRange, cell.EntireRow).Offset(, 1).Copy Sheets("Sheet1").Cells(Rows.Count, "L").End(xlUp).Offset(1) 
      cell.Interior.Color = vbYellow 
     End if 
    Next cell 
End With

然後，您可以刪除第一個循環

For Each cell In Range("B2", Cells(Rows.Count, "B").End(xlUp)) 
    If Range("A:A").Find(What:=cell.Value2, LookAt:=xlWhole) Is Nothing Then cell.Interior.Color = vbYellow 
Next cell

來源

2017-01-31 23:51:22 Gordon

謝謝，這有幫助 - 有沒有辦法清理我的代碼之上？我使用。選擇很多，因爲宏錄像機，我知道這不是最佳做法。 @Gordon – CC268

宏記錄器是一個很好的方式來找出你需要使用什麼代碼。您可以通過合併2行來清理有時冗餘的選擇代碼，例如列（「L：L」）。選擇Selection.Copy到Columns（「L：L」）。複製以便將「Selection」替換爲剛剛選擇的範圍。注意選擇選擇工作表的部分。我不認爲你的速度會有太大的提高，但它會變得很整齊。 – Gordon

優化緩慢的VBA代碼

回答

相關問題