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

晚上好…

我对VBA非常新鲜…只用了一个星期，需要帮助优化一个macros。

目前，它需要大约23秒的时间来运行…并希望能把它弄下来。

第一步是“select文件位置”的button，然后将DB中的一个表下载到名为“hidden”的工作表中，最后将列B：L从“隐藏”复制到“UPS关税”

任何build议，非常感谢

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连接，这可能会放慢整个过程。 尽pipe如此，在代码中你可以改进的东西很less：

• 1）不要做很多range.selects。

• 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' eg 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, ...例如worksheet_Activate, Worksheet_Change, ...

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

通常我所做的就是创build一个新的模块，放置所有的支持代码。 在那里我创build了以下两个function：

 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 

正如你所看到的，这些function被标记为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 

你可以看到，是重要的错误捕手。 我真的会推荐阅读更多关于这些在线。 基本上这里的代码是这样的，如果在代码执行过程中失败了（我做了一个例子，你试图用零除），那么代码不会完全失败，而是会向用户显示错误消息错误描述。 此外，它确保如果代码失败，您的EnableExcelmacros将被执行，无论如何。

这些只是我可以提供的一些提示。 你用VBA工作的越多，阅读的越多（例如在StackOverflow上），你就越好。 祝你好运！