我正在编写一个VBA脚本，该脚本可查找指定半径内的邮政编码。我在一个表中有多个记录的Access数据库。每个记录在表上都有一个“名称”，“地址”和“邮政编码”字段。访问时的VBA代码会提示用户输入邮政编码和搜索半径，然后为每个记录计算用户输入的邮政编码和邮政编码之间的距离。一旦计算出每个距离，只要记录在半径输入字段内，记录就会显示在表格上。
我编写的代码可以工作，但是执行时间太长（2000ish记录大约需要30秒）。如何减少此VBA代码运行所需的时间？这是我编写的代码：
Private Sub Command65_Click()
Dim StartTime As Double
Dim SecondsElapsed As Double
Dim i, j As Integer
Dim db As Database
Dim rs As Recordset
Dim ZIP, r As Double
Dim arr(33144, 3) As Double
Dim lat1, long1, lat2, long2, theta As Double
Dim Distance As Integer
Dim deg2rad, rad2deg As Double
Const PI As Double = 3.14159265359
'Dim Variables
StartTime = Timer
deg2rad = PI / 180
rad2deg = 180 / PI
r = Text1.Value
ZIP = Text2.Value
'Get radius and prompted zip code from form
Set db = CurrentDb
Set rs = db.OpenRecordset("US Zip Codes")
'Open the Table named "US Zip Codes"
For i = 0 To 33143
arr(i, 0) = rs.Fields("ZIP")
arr(i, 1) = rs.Fields("LAT")
arr(i, 2) = rs.Fields("LNG")
rs.MoveNext
Next i
'Loop through each Zip Code record and store the Zip Code, Lattitude Point, and Longitude Point to an array
For i = 0 To 33143
If ZIP = arr(i, 0) Then
lat1 = arr(i, 1) * deg2rad
long1 = arr(i, 2) * deg2rad
End If
Next i
'Loop through the zip code array to get Zip Code's corresponding LAT and LONG
Set rs = db.OpenRecordset("Clinics")
'Open the Table named "Clinics"
For j = 0 To 2094
If rs("Clinic ZIP") = ZIP Then
Distance = 0
'If Zip Code 1 and Zip Code 2 are equal to each other, Distance = 0
ElseIf rs("Clinic ZIP") <> "" Then
zip2 = rs("Clinic ZIP")
For i = 0 To 33143
If zip2 = arr(i, 0) Then
lat2 = arr(i, 1) * deg2rad
long2 = arr(i, 2) * deg2rad
End If
Next i
'Loop through the zip code array to get the second Zip Code's corresponding LAT and LONG
theta = long1 - long2
Distance = ArcCOS(Sin(lat1) * Sin(lat2) + Cos(lat1) * Cos(lat2) * Cos(theta)) * rad2deg * 60 * 1.1515
'Calculate Distance between the two zip codes
Else
Distance = 999
'Set Arbitrary Value if the zip code field is empty
End If
rs.Edit
rs.Fields("Distance") = Distance
rs.Update
rs.MoveNext
Next j
Me.Filter = "Distance<=" & r
Me.FilterOn = True
'Filter the table with calculated distance by prompted radius
Forms("Zip Search").Requery
rs.Close
Set rs = Nothing
db.Close
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
答案 0 :(得分：7)
我刚刚对1976个餐厅位置进行了测试：
ID lon lat poi_name
-- --------- -------- ---------------------------------------------
1 -114.063 51.0466 Palomino Smokehouse: Calgary, AB
2 -114.055 51.0494 Bookers BBQ Grill and Crab Shack: Calgary, AB
3 -86.97871 34.58037 Big Bob Gibson's Original: Decatur, AL
4 -87.01763 34.56587 Big Bob Gibson's #2: Decatur, AL
5 -86.364 32.26995 DJ's Old Post Office: Hope Hull, AL
...
使用{... 1提供的功能...
http://www.cpearson.com/excel/LatLong.aspx
...我运行以下查询以计算距给定点的距离
GreatCircleDistance结果在不到一秒钟的时间内回来了。
然后返回距我使用的给定点一定距离之内的结果
PARAMETERS prmLon IEEEDouble, prmLat IEEEDouble;
SELECT BBQ2.ID, BBQ2.lon, BBQ2.lat, BBQ2.poi_name,
GreatCircleDistance([prmLat],[prmLon],[lat],[lon],True,False) AS km
FROM BBQ2;
再次，结果在不到一秒钟的时间内返回。
答案 1 :(得分：2)
应用注释来修改代码，请考虑以下假设（假设ArcCos（）是公共自定义UDF）。另外，两个查询对象被引用为数据源。一种是查询ZipCodes表，该表计算lat和long值。另一个是将Clinics表连接到上述查询的查询。
import * as functions from 'firebase-functions';
import * as Storage from '@google-cloud/storage';
import * as sharp from 'sharp';
import * as fs from 'fs-extra';
import { tmpdir } from 'os';
import { join, dirname } from 'path';
/* Variaveis Globais */
const gcs = new Storage();
/* Criando o metodo principal */
export const generateThumbs = functions.storage
.object()
.onFinalize(async object => {
/* Instanciando as constantes */
const bucket = gcs.bucket(object.bucket);
const filePath = object.name;
const contentType = object.contentType;
const fileName = filePath.split('/').pop();
const bucketDir = dirname(filePath);
const customMetadata = object.metadata;
/* Criando o diretorio e o path temporario */
const workingDir = join (tmpdir(), 'thumbs');
const tmpFilePath = join (workingDir, 'source.png');
/* Verificando se a imagem e a default */
if (fileName.includes('default')) {
console.log ('Imagem default não pode ser alterada, saindo da função....');
return false;
}
/* Verificando se o customMetadata existes */
if ( typeof customMetadata['edited'] === "undefined") {
customMetadata['edited'] = "false";
}
/* Verificando se a imagem e JPEG ou se ja foi alterada */
if (!object.contentType.includes('image/') || customMetadata['edited'].includes('true')) {
console.log ('O arquivo já foi alterado ou não é uma imagem, saindo da função...');
return false;
}
/* 1. Garantido que o diretorio do thumbnail existe */
await fs.ensureDir (workingDir);
/* 2. Fazendo o download do arquivo de origem */
console.log ('Fazendo o download do arquivo no path: ' + filePath);
await bucket.file(filePath).download({
destination: tmpFilePath
});
/* 3. Redimensionando as imagens e definindo o array de promisses */
//const sizes = [64, 128, 256];
const sizes = [256];
const uploadPromises = sizes.map(async size => {
console.log ('Redimensionando a imagem e convertendo para JPEG.');
//const thumbName = `thumbs@${size}_${fileName}`;
const thumbName = `${fileName}`;
const thumbPath = join (workingDir, thumbName);
/* Redimensionando a imagem de origem */
await sharp (tmpFilePath)
.resize(size, size)
.toFormat('jpeg')
.toFile(thumbPath);
/* Upload para o GCS */
console.log('Fazendo o upload para o GCS.');
return bucket.upload(thumbPath, {
destination: join(bucketDir, thumbName),
metadata: {
contentType: contentType,
metadata: {
'edited': 'true'
},
}
});
/* Atualizando os metadatas */
});
/* Realizando o upload */
console.log('Fazendo o upload do promisse');
await Promise.all(uploadPromises);
/* Limpando os arquivos temporarios */
console.log ('Removendo os arquivos temporarios e finalizando...');
return fs.remove (workingDir);
});
但是，在多用户数据库中，用户在写入共享表的距离时会互相冲突。如果有多个用户，则必须拆分db，并在前端将一个临时表（表是永久性的，记录是临时的）写入表中，并将其作为ReportRecordSource。避免记录编辑/保存的解决方案将是最理想的，现在我看到已经提供了一个解决方案。