Question

我以前有这段代码，我需要从一个大报告中创建38个报告。以前可以使用，但是我们添加了一些功能，现在不起作用了。尽管我阅读了其他答案，但我对循环程序的理解却很差

因此，我认为这是造成问题的部分。它需要经过5602行，甚至需要几分钟才能达到50。

Do While v <= n
   If Cells(v, 2) <> "" And Cells(v, 2) <> "Call Center" And Cells(v, 2) <> drzava Then Rows(v).Delete Else v = v + 1
    Loop

这就是全部：

Sub SaveALLCountries()

Dim drzava$, nov As Workbook, ime$, v%, n%, a  As Double

Application.ScreenUpdating = False

For i = 1 To 38
    ThisWorkbook.Activate
    Application.StatusBar = i
    ThisWorkbook.Sheets("Results by CC").Range("CB14") = i
    drzava = ThisWorkbook.Sheets("Results by CC").Range("CD12")
    Workbooks.Add
    Set nov = ActiveWorkbook
    ThisWorkbook.Sheets("Results by CC").Copy Before:=nov.Sheets(1)
    ActiveSheet.Shapes.Range(Array("List Box 2")).Delete
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("A1").Select
    ThisWorkbook.Sheets("2018 Q2 Open answers").Copy Before:=nov.Sheets(2)
    Application.DisplayAlerts = False
    nov.Sheets(3).Delete
    Sheets("2018 Q2 Open answers").Select
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    n = Application.WorksheetFunction.CountA(Sheets("2018 Q2 Open answers").Columns(2)) + 10
    v = 1
    Do While v <= n
        If Cells(v, 2) <> "" And Cells(v, 2) <> "Call Center" And Cells(v, 2) <> drzava Then Rows(v).Delete Else v = v + 1
    Loop
    ActiveSheet.Outline.ShowLevels RowLevels:=1
    Range("A1").Select
    ActiveWorkbook.Names("CallCenterSelect").Delete
    Sheets("Results by CC").Select
    ime = ThisWorkbook.Path & "\" & Sheets("Results by CC").Range("CD14").Value & ".xlsx"
    nov.SaveAs ime, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    nov.Close

Next i

Application.ScreenUpdating = True
Application.StatusBar = False

结束子

Answer 1

首先，您应该try avoiding using select and active-whatever as much as possible。您还应该尝试尽可能明确地限定正在处理的对象，尤其是同时处理多个不同的工作簿时。例如，您确定在这些行中正在执行的操作，并且确定您在正确的范围内执行操作吗？因为我不是，尽管其中有些可能是因为我面前没有工作簿。

Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("A1").Select

我想这可能与删除格式有关？如果是这样，可能有更有效的方法。

最后，在运行代码时关闭某些属性可能会有所帮助，以便加快速度。我经常在运行的任何代码的开头和结尾使用这些小宏：

Sub deactivate()
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  Application.DisplayStatusBar = False
  Application.Calculation = xlCalculationManual
End Sub

Sub reaktiver()
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Application.DisplayStatusBar = True
  Application.Calculation = xlCalculationAutomatic
End Sub

请注意，如果您依赖于代码运行时所进行的计算，则必须在Application.Calculation设置为xlCalculationManual的情况下显式地执行此操作。

此外，我看到您在代码运行时在状态栏中打印了一些内容，并且如果Application.DisplayStatusBar为false，则不会显示。您必须决定将属性设置为false来显示信息是否超过您获得的额外速度。

有很多关于如何在Web上优化VBA代码的文章，以获取有关关闭哪些属性以及将要执行的操作的更好信息的更多信息，例如您可以使用have a look here。

VBA宏中的慢循环

1 个答案: