试图使代码更有效和稳定
我有一个程序，这是有效的，我只是觉得它运行速度比它应该慢，我觉得它比它应该更不稳定。 我正在寻找写“更好”的代码，使我的程序更稳定的提示。
我现在正在寻找更好的这部分代码：
Private Sub Worksheet_Activate() Application.ScreenUpdating = False 'Removes shapes already there that will be updated by the getWeather function For Each delShape In Shapes If delShape.Type = msoAutoShape Then delShape.Delete Next delShape 'Calls a function to get weather data from a web service Call getWeather("", "Area1") Call getWeather("", "Area2") Call getWeather("", "Area3") 'Starting to implement the first connection to a SQL Access database. Dim cn As Object Dim rs As Object 'Set cn and sqlConnect as ADODB-objects. Set rs as recordset Set cn = CreateObject("ADODB.Connection") Set sqlConnect = New ADODB.Connection Set rs = CreateObject("ADODB.RecordSet") 'Set sqlConnect as connection string sqlConnect.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\databases\database.accdb;Persist Security Info=False;" 'Open connection string via connection object cn.Open sqlConnect 'Set rs.Activeconnection to cn rs.ActiveConnection = cn 'Get a username from the application to be used further down Brukernavn = Application.userName 'This part of the code re-arranges the date format from american to european StartDate = Date EndDate = Date - 7 midStartDate = Split(StartDate, ".") midEndDate = Split(EndDate, ".") StartDate2 = "" & midStartDate(1) & "/" & midStartDate(0) & "/" & midStartDate(2) & "" EndDate2 = "" & midEndDate(1) & "/" & midEndDate(0) & "/" & midEndDate(2) & "" 'SQL statement to get data from the access database rs.Open "SELECT [RefNr], [Registrert Av],[Nettstasjon], [Meldt Dato] , [Bestilling], [Sekundærstasjon], [Avgang], [Hovedkomponent], [HovedÅrsak], [Status Bestilling] FROM [tblDatabase]" & _ "WHERE [Registrert Av] = '" & Brukernavn & "' AND [Loggtype] <> 'Beskjed' AND [Meldt Dato] BETWEEN #" & StartDate2 & "# AND # " & EndDate2 & "#" & _ "ORDER BY [Meldt Dato] DESC;", _ cn, adOpenStatic 'Start to insert data from access database into a list Dim i As Integer Dim u As Integer If Not rs.EOF Then rs.MoveFirst End If i = 0 With lst_SisteFeil .Clear Do If Not rs.EOF Then .AddItem If Not IsNull(rs!refnr) Then .List(i, 0) = rs![refnr] End If If IsDate(rs![Meldt Dato]) Then .List(i, 1) = Format(rs![Meldt Dato], "dd/mm/yy") End If .List(i, 4) = rs![nettstasjon] If Not IsNull(rs![Sekundærstasjon]) Then .List(i, 2) = rs![Sekundærstasjon] End If If Not IsNull(rs![Avgang]) Then .List(i, 3) = rs![Avgang] End If If Not IsNull(rs![Hovedkomponent]) Then .List(i, 5) = rs![Hovedkomponent] End If If Not IsNull(rs![HovedÅrsak]) Then .List(i, 6) = rs![HovedÅrsak] End If If Not IsNull(rs![Status Bestilling]) Then .List(i, 7) = rs![Status Bestilling] End If If Not IsNull(rs![bestilling]) Then .List(i, 8) = rs![bestilling] End If i = i + 1 rs.MoveNext Else GoTo endOfFile End If Loop Until rs.EOF End With endOfFile: rs.Close cn.Close Set rs = Nothing Set cn = Nothing 'Starts to connect to SQL access database again to get different set of data. This must be possible to make more efficient? Dim cn2 As Object Dim rs2 As Object 'Set cn and sqlConnect as ADODB-objects. Set rs as recordset Set cn2 = CreateObject("ADODB.Connection") Set sqlConnect2 = New ADODB.Connection Set rs2 = CreateObject("ADODB.RecordSet") 'Set sqlConnect as connection string sqlConnect2.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\databases\database.accdb;Persist Security Info=False;" 'Open connection string via connection object cn2.Open sqlConnect 'Set rs.Activeconnection to cn rs2.ActiveConnection = cn2 'Second SQL statement rs2.Open "SELECT [RefNr], [Registrert Av],[Nettstasjon], [Meldt Dato] , [Bestilling], [Sekundærstasjon], [Avgang], [Hovedkomponent], [HovedÅrsak], [Status Bestilling] FROM [tblDatabase]" & _ "WHERE [Registrert Av] <> '" & Brukernavn & "' AND [Meldt Dato] BETWEEN #" & StartDate2 & "# AND # " & EndDate2 & "#" & _ "ORDER BY [Meldt Dato] DESC;", _ cn2, adOpenStatic 'Inserting into second list If Not rs2.EOF Then rs2.MoveFirst End If u = 0 With lst_AlleFeil .Clear Do If Not rs2.EOF Then .AddItem If Not IsNull(rs2!refnr) Then .List(u, 0) = rs2![refnr] End If If IsDate(rs2![Meldt Dato]) Then .List(u, 1) = Format(rs2![Meldt Dato], "dd/mm/yy") End If .List(u, 4) = rs2![nettstasjon] If Not IsNull(rs2![Sekundærstasjon]) Then .List(u, 2) = rs2![Sekundærstasjon] End If If Not IsNull(rs2![Avgang]) Then .List(u, 3) = rs2![Avgang] End If If Not IsNull(rs2![Hovedkomponent]) Then .List(u, 5) = rs2![Hovedkomponent] End If If Not IsNull(rs2![HovedÅrsak]) Then .List(u, 6) = rs2![HovedÅrsak] End If If Not IsNull(rs2![Status Bestilling]) Then .List(u, 7) = rs2![Status Bestilling] End If If Not IsNull(rs2![bestilling]) Then .List(u, 8) = rs2![bestilling] End If u = u + 1 rs2.MoveNext Else GoTo endOfFile2 End If Loop Until rs2.EOF End With endOfFile2: rs2.Close cn2.Close Set rs2 = Nothing Set cn2 = Nothing 'Starting to connect to the database for the third time Dim cn3 As Object Dim rs3 As Object 'Set cn and sqlConnect as ADODB-objects. Set rs as recordset Set cn3 = CreateObject("ADODB.Connection") Set sqlConnect3 = New ADODB.Connection Set rs3 = CreateObject("ADODB.RecordSet") 'Set sqlConnect as connection string sqlConnect3.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\databases\database.accdb;Persist Security Info=False;" 'Open connection string via connection object cn3.Open sqlConnect 'Set rs.Activeconnection to cn rs3.ActiveConnection = cn3 'third sql statement rs3.Open "SELECT [RefNr], [Registrert Av],[Nettstasjon], [Meldt Dato], [Sekundærstasjon], [Avgang], [Beskrivelse], [Til Dato] FROM [tblDatabase]" & _ "WHERE [Loggtype] = 'Beskjed' AND [Meldt Dato] >= DateAdd('d',-30,Date())" & _ "ORDER BY [Meldt Dato] DESC;", _ cn3, adOpenStatic 'Inserting data in to third list If Not rs3.EOF Then rs3.MoveFirst End If j = 0 With lst_beskjeder .Clear Do If Not rs3.EOF Then .AddItem If Not IsNull(rs3!refnr) Then .List(j, 0) = rs3![refnr] End If If IsDate(rs3![Meldt Dato]) Then .List(j, 1) = Format(rs3![Meldt Dato], "dd/mm/yy") End If .List(j, 4) = rs3![nettstasjon] If Not IsNull(rs3![Sekundærstasjon]) Then .List(j, 2) = rs3![Sekundærstasjon] End If If Not IsNull(rs3![Avgang]) Then .List(j, 3) = rs3![Avgang] End If If Not IsNull(rs3![beskrivelse]) Then .List(j, 5) = rs3![beskrivelse] End If j = j + 1 rs3.MoveNext Else GoTo endOfFile3 End If Loop Until rs3.EOF End With endOfFile3: rs3.Close cn3.Close Set rs3 = Nothing Set cn3 = Nothing End Sub 这是我用来获取天气数据的function。
Public Sub getWeather(APIurl As String, sted As String) Dim i As Integer i = 0 Dim omraade As String omraade = "" omraade = sted If sted = "Area1" Then i = 4 ElseIf sted = "Area2" Then i = 6 ElseIf sted = "Area3" Then i = 8 End If Dim WS As Worksheet: Set WS = ActiveSheet Dim delShape As Shape Dim city As String Dim Req As New XMLHTTP Req.Open "GET", "" & APIurl & "", False Req.Send Dim Resp As New DOMDocument Resp.LoadXML Req.responseText Dim Weather As IXMLDOMNode Dim wShape As Shape Dim thisCell As Range For Each Weather In Resp.getElementsByTagName("current_condition") Set thisCell = WS.Range(Cells(2, i), Cells(2, i)) Set wShape = WS.Shapes.AddShape(msoShapeRectangle, thisCell.Left, thisCell.Top, thisCell.Width, thisCell.Height) wShape.Fill.UserPicture Weather.ChildNodes(4).Text 'img Cells(3, i).Value = "" & Weather.ChildNodes(7).Text * 0.28 & " m/s" 'windspeedkmph Cells(4, i).Value = Weather.ChildNodes(9).Text 'Direction Cells(5, i).Value = Weather.ChildNodes(1).Text & " C" 'observation time Next Weather End Sub
随意指出任何可怜的编码和提示如何改进。 我目前使用工作表激活子来激活表中的变化，并获得新的数据，但我怀疑这不是最好的解决scheme。 我只是不知道该怎么做，因为我希望它是尽可能“自动”，并尽可能使用尽可能less的button来刷新。
谢谢你的帮助。
– 托马斯
一些技巧，但没有一个会影响性能，只有帮助你的代码更简洁。
1。
rs.Open "SELECT ..." If Not rs.EOF Then rs.MoveFirst End If
.MoveFirst是不必要的。 打开logging集后，如果有logging，则始终在第一条logging上。
在VBA中构build复杂的SQL时，请参阅如何在VBA中debuggingdynamicSQL 。
2。
不要做一个Do ... Until循环logging集：
Do If Not rs.EOF Then ' do stuff for each record ' ... rs.MoveNext Else GoTo endOfFile End If Loop Until rs.EOF endOfFile: rs.Close
相反，使用Do While Not rs.EOF ：
Do While Not rs.EOF ' do stuff for each record ' ... rs.MoveNext Loop rs.Close
对于空的rs ，循环将不会被input。 你不需要If/Else和Goto 。