Question

晚安...

我对VBA很新...只玩了大约一个星期，并且需要帮助优化宏。

目前它需要大约23秒的时间才能运行......而且希望能让它稍微下降。

第一步是按下按钮，选择文件位置＆＃34; 然后将来自数据库的一个表下载到名为＆＃34; hidden＆＃34;的工作表中。最后列B：L从＆＃34;隐藏＆＃34;到＆＃34; UPS关税＆＃34;

非常感谢任何建议

Sub Selectfile()

Dim filename As String

filename = Application.GetOpenFilename(MultiSelect:=False)

Range("c2") = filename

Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer

Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sQRY As String
Dim rng As Range
Dim cell As Range
Dim sourcefile As String


sourcefile = Sheet1.Range("C2")
Sheets("Hidden").Visible = True
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set rng = Sheet9.Range("B1:B762")

cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & sourcefile & ";"
sQRY = "SELECT * FROM Tariff"
rs.CursorLocation = adUseClient
rs.Open sQRY, cnn, adOpenStatic, adLockReadOnly
Application.ScreenUpdating = False
Sheet9.Range("A1").CopyFromRecordset rs
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing

For Each cell In rng
If cell <> "Letter" And cell <> "NDA" And cell <> "NDAS" And cell <> "2DA" And cell <> "3DS" And cell <> "GND" Then cell.Value = cell.Value * 1
Next cell

    Sheets("Hidden").Select
    Range("B1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("UPS Tariff").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Hidden").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Clear
    Sheets("Info").Select

Sheets("Hidden").Visible = xlVeryHidden
SecondsElapsed = Round(Timer - StartTime, 2)

'Notify user in seconds
  MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

End Sub

Answer 1

您正在进行OLEDB连接，这可能会减慢整个过程。尽管如此，您可以在代码中改进一些内容：

1）不要做那么多范围选择。

2）尝试在代码中使用with语句。这会加快你的过程。

例如以下代码：

Sheets("Hidden").Select
Range("B1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("UPS Tariff").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("A1").Select
Sheets("Hidden").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Clear
Sheets("Info").Select

可以转换成这样的东西：

    With Sheets("Hidden")
       'copy your selection
       .Range(.cells(1,2), .cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Copy' e.g. if you want to select the whole area in the worksheet

       'paste selection to the destination cell
       Sheets("UPS Tariff").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
           :=False, Transpose:=False

       Application.CutCopyMode = False'gets rid of the highlighted copy area under your Sheets workbook

       'clears the initial selection
       .Range(.cells(1,2), .cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Clear
    End With

    Sheets("Info").Select

不仅代码对VBA处理器变得更有效率，而且一旦您需要查看/更改它，它也更具可读性。

真正加速这个过程的另一件事是以下几行：

Application.ScreenUpdating = False

每次执行新的代码行时，屏幕都会停止闪烁。

Application.Calculation = xlCalculationManual

每次在工作表中进行更改时，上面的内容都会停止重新计算的所有公式。

Application.EnableEvents = false

另一个禁用所有工作表事件，例如worksheet_Activate, Worksheet_Change, ...

但是，您需要确保一旦所有代码完成运行，您再次打开这些功能（否则您的单元格将停止重新计算，屏幕将自动停止刷新）。

通常我所做的是创建一个新模块，我将所有支持代码放在其中。在那里，我创建了以下两个函数：

Public Sub EnableExcel()
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

Public Sub DisableExcel()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
End Sub

如您所见，这些功能标记为public，因此可以在工作簿中的任何位置访问。

然后我的程序看起来像这样：

Private Sub DoSomeStuff()
    On Error GoTo EarlyExit
    Call DisableExcel

    'this will fail as it is division by zero
    MsgBox 1 / 0

EarlyExit:
    Call EnableExcel
    If Err.Description <> vbNullString Then MsgBox Err.Description
End Sub

你能看到的是重要的错误捕捉者。我真的建议在线阅读更多关于这些内容。基本上代码在这里做的是，如果在代码执行过程中出现问题（我做了一个你试图除以零的例子），那么代码就不会完全失败，而是会向用户显示错误消息错误描述。此外，它确保如果代码失败，无论如何都会执行EnableExcel宏。

这些只是我能给出的一些提示。您使用VBA的次数越多，阅读的越多（例如在StackOverflow上），您就越好。祝你好运！

VBA编程新手，需要帮助优化VBA代码

1 个答案: