Private Sub txtYuubinCount_Click()
On Error GoTo EndMacro
If ConnectDatabase = False Then
Exit Sub
End If
Dim recYuubinCount As New ADODB.Recordset
Dim recFiveKM As New ADODB.Recordset
Dim recTenKM As New ADODB.Recordset
Dim recFifteenKM As New ADODB.Recordset
strsql = "Select Distinct YuubinBangou,round(Latitude,4) as Latitude,round(Longitude,4) as Longitude from CompleteYuubinwithlatlon where FiveKmCount is null"
recYuubinCount.Open strsql, conn
recYuubinCount.MoveFirst
Do
strsql = "SELECT COUNT(distinct sub.yuubinbangou) as fivecount FROM (SELECT ((ACOS(SIN(" & recYuubinCount![Latitude] & " * PI() / 180) * SIN(latitude * PI() / 180) + COS(" & recYuubinCount![Latitude] & " * PI() / 180) * COS(latitude * PI() / 180) * COS((" & recYuubinCount![Longitude] & " - longitude) * PI() / 180)) * 180 / PI()) * 60 * 1.1515) AS rangea,yuubinbangou FROM completeyuubinwithlatlon) sub WHERE sub.rangea<=3.1056 and sub.rangea>0"
recFiveKM.Open strsql, conn
recFiveKM.MoveFirst
strsql = "SELECT COUNT(distinct sub.yuubinbangou) as tencount FROM (SELECT ((ACOS(SIN(" & recYuubinCount![Latitude] & " * PI() / 180) * SIN(latitude * PI() / 180) + COS(" & recYuubinCount![Latitude] & " * PI() / 180) * COS(latitude * PI() / 180) * COS((" & recYuubinCount![Longitude] & " - longitude) * PI() / 180)) * 180 / PI()) * 60 * 1.1515) AS rangeb,yuubinbangou FROM completeyuubinwithlatlon) sub WHERE sub.rangeb<=6.2112 and sub.rangeb>0"
recTenKM.Open strsql, conn
recTenKM.MoveFirst
strsql = "SELECT COUNT(distinct sub.yuubinbangou) as fifteencount FROM (SELECT ((ACOS(SIN(" & recYuubinCount![Latitude] & " * PI() / 180) * SIN(latitude * PI() / 180) + COS(" & recYuubinCount![Latitude] & " * PI() / 180) * COS(latitude * PI() / 180) * COS((" & recYuubinCount![Longitude] & " - longitude) * PI() / 180)) * 180 / PI()) * 60 * 1.1515) AS rangec,yuubinbangou FROM completeyuubinwithlatlon) sub WHERE sub.rangec<=9.3168 and sub.rangec>0"
recFifteenKM.Open strsql, conn
recFifteenKM.MoveFirst
strsql = "Update CompleteYuubinWithLatLon set fivekmcount=" & recFiveKM![fivecount] & ",tenkmcount=" & recTenKM![tencount] & ",fifteenkmcount=" & recFifteenKM![fifteencount] & " where Yuubinbangou=" & recYuubinCount![YuubinBangou]
conn.Execute strsql
recFiveKM.Close
Set recFiveKM = Nothing
recTenKM.Close
Set recTenKM = Nothing
recFifteenKM.Close
Set recFifteenKM = Nothing
recYuubinCount.MoveNext
Loop Until recYuubinCount.EOF
MsgBox "yes"
Exit Sub
EndMacro:
MsgBox "error"
End Sub
I have this macro running good but the problem is it is too slow. I need to update 121 thousand records and it processes 1 record per 2 seconds...that would take me around more than 2 days to get it done. Is there any way I can optimize this code? I know its in the sql statement but I am not really good at it.
What it does is it gets all records from say table1 from the selected records(PostalNumber(YuubinBangou in code),Latitude,Longitude) it computes the number of nearby locations based on their latitude and longitude. After counting it updates table1 with the number of nearby locations (5km,10km,15km in the code it is 3.1056mi,6.2112mi,9.3168mi)per postalNumber.
Any help would be greatly appreciated. Thank you!
Bookmarks