| |
▼Satsuki さん：
こんにちは。
Satsuki さんのコードを生かす形ですと
こんな感じになると思われます。
Public Sub keisan()
Dim cn As ADODB.Connection
Dim rs1 As ADODB.Recordset
Dim rs2 As ADODB.Recordset
Dim rs3 As ADODB.Recordset
Dim rs4 As ADODB.Recordset
Dim i As Long
Set cn = CurrentProject.Connection
Set rs1 = New ADODB.Recordset
Set rs2 = New ADODB.Recordset
Set rs3 = New ADODB.Recordset
Set rs4 = New ADODB.Recordset
rs1.Open "データ", cn, adOpenStatic, adLockReadOnly
rs2.Open "位置", cn, adOpenStatic, adLockReadOnly
rs3.Open "距離", cn, adOpenKeyset, adLockOptimistic
rs4.Open "TOP5", cn, adOpenKeyset, adLockOptimistic
'rs1.MoveFirst → 不要
Do Until rs1.EOF
rs2.MoveFirst
Do Until rs2.EOF
rs3.AddNew
rs3![kyotenmei] = rs2![拠点名]
rs3![kyoriX] = rs2![X1] - rs1![X]
rs3![kyoriY] = rs2![Y1] - rs1![y]
rs3![kyori] = Sqr((Abs(rs1![X] - rs2![X1]) * 30.82) ^ 2 _
+ (Abs(rs1![y] - rs2![Y1]) * 25.15) ^ 2) / 1000
rs3.Update
rs2.MoveNext
Loop
rs3.Close
'rs3.CursorLocation = adUseClient → adUseServerに変更
rs3.CursorLocation = adUseServer
'rs3.Open "距離", cn, adOpenKeyset, adLockOptimistic
'rs3.Sort = "kyori DESC" → 下記行に集約
rs3.Open "SELECT TOP 5 * FROM 距離 ORDER BY kyori DESC", _
cn, adOpenKeyset, adLockOptimistic
'i = 0 → 不要
'For i = 1 To 5 → 不要
Do Until rs3.EOF '→追加
rs4.AddNew
rs4![kyotenmei] = rs3![kyotenmei]
rs4![kyoriX] = rs3![kyoriX]
rs4![kyoriY] = rs3![kyoriY]
'i = i + 1 → 不要
rs4.Update
'Next i → 不要
rs3.MoveNext '→ 追加
Loop
rs3.MoveFirst '→ 追加
Do Until rs3.EOF
rs3.Delete
rs3.MoveNext
Loop
'rs3.Close → 不要
rs1.MoveNext
Loop
rs1.Close
rs2.Close
rs3.Close
cn.Close
'以下追加
rs4.Close
Set rs4 = Nothing
Set rs3 = Nothing
Set rs2 = Nothing
Set rs1 = Nothing
Set cn = Nothing
End Sub
> 少数点以下13桁ぐらいの値で計算しても、
> 計算結果は少数点以下がまったく計算されません
数値データのフィールドサイズは
「単精度浮動小数点型」「倍精度浮動小数点型」
のどちらかになっていますでしょうか？
（怪しいのはワークテーブル：距離ですね…)
どこか一つでも長整数型のフィールドがあると
丸められて整数値で返ってきてしまいますよ^^
> Delete時のエラーは現在もでます。
位置テーブルの「拠点名」に重複はありませんか？
もし無いのであれば、距離テーブルの kyotenmei に主キー設定をすると
エラー回避になるかもしれません。
> kyoriX DESC
遠い拠点5箇所、で良いのでしょうか。
最寄5箇所を探すのであれば ASC のような気もしますが…。
以上まずはここまで…。
|
|
![[未読]](./data/access/image/read_icon.gif){kind=icon}
