我有一个程序，有效，我觉得它运行速度比它应该慢，我觉得它比它应该更不稳定。我正在寻找关于编写“更好”代码并使我的程序更稳定的技巧。
我现在希望更好地使用我的代码部分：
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
这是我用来获取天气数据的功能。
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
随意指出任何糟糕的编码和如何改进它的提示。我目前正在使用工作表激活子来激活表中的更改并获取新数据，但我怀疑这不是最佳解决方案。我只是不确定如何看待它，因为我希望它尽可能“自动”，并使用尽可能少的按钮来刷新。
感谢您的帮助。
-Thomas
答案 0 :(得分：1)
一些提示，但没有一个会影响性能，只会帮助您的代码更简洁。
1
rs.Open "SELECT ..."
If Not rs.EOF Then
rs.MoveFirst
End If
.MoveFirst是不必要的。打开记录集后，如果有记录，则总是在第一条记录上。
在VBA中构建复杂的SQL时，请查看How to debug dynamic SQL in VBA。
2
不要为记录集执行Do ... Until循环：
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，将不会输入循环。您不需要If/Else和Goto。