如何提高我的VBAmacros代码的执行速度？
我向您提供了我的macros的代码，并希望有人能告诉我什么是使我的macros慢，并提供了一个解决scheme，如何使其运行速度更快。 目前这个代码的执行时间大约需要1分钟，但是我仍然需要提高执行时间，任何帮助都将不胜感激。 以下是代码：
Dim con As ADODB.Connection Dim rs As ADODB.Recordset Dim query As String Dim Fond As String Dim KontoNr As String Dim StartDate As Date Dim EndDate As Date Dim wb As Workbook Dim wr As Worksheet Dim ws As Worksheet Dim wt As Worksheet Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayStatusBar = False Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False Set wb = ActiveWorkbook Set wr = Sheets("Fee") Set ws = Sheets("TestExecution") Set wt = Sheets("Results_Overview") 'wr.UsedRange.Interior.ColorIndex = 0 With wr.UsedRange RowCount = .Rows.Count If (RowCount > 1) Then wr.Range(2 & ":" & RowCount).EntireRow.Delete End If End With With wt.UsedRange RowCount = .Rows.Count If (RowCount > 2) Then wt.Range(2 & ":" & RowCount).EntireRow.Delete End If End With With ws.UsedRange ws.Range(Cells(2, 1), Cells(.Rows.Count, 1)).ClearContents ws.Range(Cells(2, 6), Cells(.Rows.Count, 15)).ClearContents End With Dim r As Long Dim Count As Integer Dim a As Integer Dim Counter As Integer Set con = New ADODB.Connection Set rs = New ADODB.Recordset PeriodStartDate = ws.Cells(2, 4).Value PeriodEndDate = ws.Cells(3, 4).Value KontoNr = ws.Cells(4, 4).Value Count = DatePart("d", PeriodEndDate) strCon = "Provider=SQLOLEDB; " & _ "Data Source= XXX;" & _ "Initial Catalog=XX;" & _ "Integrated Security=SSPI" con.Open (strCon) query = "SELECT distinct Fond FROM RI_Trans_Akt ta WITH (NOLOCK) WHERE cast(ta.Avslutsdag as date) < '" & PeriodEndDate & "'" rs.Open query, con, adOpenStatic con.Execute query Counter = rs.RecordCount ws.Cells(2, 1).CopyFromRecordset rs rs.Close con.Close Dim p As Long Dim lp As Long For p = 2 To Counter + 1 StartDate = ws.Cells(2, 4).Value a = wr.Range("A" & wr.Rows.Count).End(xlUp).Row For r = 1 To Count Fond = ws.Cells(p, 1).Value wr.Cells(a + r, 1).Value = Fond wr.Cells(a + r, 2).Value = StartDate wt.Cells(a + r, 1).Value = Fond wt.Cells(a + r, 2).Value = StartDate DateFormat = Format(StartDate, "yyyymmdd") con.Open (strCon) query = "select Totalt_Antal_Andelar,Forvaltnings_avgift,CAST(Forvaltnings_avgift_kurs AS NUMERIC(30,10)) AS Forvaltnings_avgift_Kurs from ri_fond_avgift WITH (NOLOCK) where Datum = '" & StartDate & "' and Fond = '" & Fond & "'" rs.Open query, con con.Execute query If (rs.RecordCount > 0) Then wr.Cells(a + r, 3).Value = rs.Fields(0) wr.Cells(a + r, 4).Value = rs.Fields(1) wr.Cells(a + r, 5).Value = rs.Fields(2) Else wr.Cells(a + r, 3).Value = "0.00" wr.Cells(a + r, 4).Value = "0.00" wr.Cells(a + r, 5).Value = "0.00" End If rs.Close query = "SELECT ta.KontoNr,Sum (Antal_andelar) FROM RI_Trans_Akt ta WITH (NOLOCK) WHERE ta.Kontonr = '" & KontoNr & "' and cast(ta.Avslutsdag as date) < '" & StartDate & "' and ta.Fond = '" & Fond & "' and ta.Mak_dag is null Group BY ta.Kontonr,ta.Fond" rs.Open query, con, adOpenStatic con.Execute query If (rs.RecordCount > 0) Then wr.Cells(a + r, 6).Value = rs.Fields(0) wr.Cells(a + r, 7).Value = rs.Fields(1) Else wr.Cells(a + r, 7).Value = "0.00" End If rs.Close con.Close StartDate = DateAdd("d", 1, StartDate) Next r Dim i As Integer For i = a + 1 To Count + a If (wr.Cells(i, 3).Value <> 0) Then wr.Cells(i, 8).Value = wr.Cells(i, 5).Value * wr.Cells(i, 7).Value wt.Cells(i, 3).Value = wr.Cells(i, 8).Value Else wr.Cells(i, 5).Value = "0.00" wr.Cells(i, 8).Value = "0.00" wt.Cells(i, 3).Value = "0.00" End If Next i Dim j As Integer Dim totalManagementFee As Double totalManagementFee = 0 For j = a + 1 To Count + a totalManagementFee = totalManagementFee + wr.Cells(j, 8).Value Next j ws.Cells(p, 7).Value = totalManagementFee ws.Cells(p, 6).Value = Fond Next p Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.DisplayStatusBar = True Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True End Sub 好的，所以你正在阅读和写作范围，你应该这样做，而不是在一个循环。 另外，逐一删除行将花费很多时间，您不需要这样做。 使用数组，首先将范围转换为数组，然后首先对数组执行所有validation和操作等操作，然后将数组粘贴到范围内。
将范围更改为数组只需执行以下操作：
Dim i, j As Long Dim arr() As Variant Dim rng As Range Set rng = Worksheet.Range("A1:B10") 'define your range as you wish arr = rng.Value 'access all cell values inside the array now For i = 1 To UBound(arr, 1) For j = 1 To UBound(arr, 2) 'do whatever you want to do in the array Next j Next i 'paste back the new values to the range rng.Value = arr
你也运行相同的查询两次与不同的function：rs.Open查询，con，adOpenStatic'返回一个logging集con.Execute查询'不返回logging集
删除第二行，你不需要它
您正在打开和closures同一个连接不止一次，因此您需要在执行任何SQL查询之前打开一次连接，并在结束时closures它。
con.open ' run all sql queries, no need to close the connection unless you have a very specific purpose for it con.close set con=nothing
而不是循环访问一个logging集，将数据转储到一个数组中，然后循环遍历数组，这会更快更稳定：
array = recordset.GetRows(Rows, Start, Fields )