Q、ADOで算術型のRound関数を使いたい。
A、次のようにして使えないでしょうか？
[イミディエイト]
? DBLookup("SELECT Round(111.45, 1) FROM tab2")
111.4
? DBLookup("SELECT Round(111.55, 1) FROM tab2")
111.6
? DBLookup("SELECT Round(111.45 + 0.01, 1) FROM tab2")
111.5
? DBLookup("SELECT Round(111.55 + 0.01, 1) FROM tab2")
111.6
? DBLookup("SELECT fld_1 FROM tab2")
111.45
? DBLookup("SELECT Round(fld_1 + 0.01 * sgn(fld_1), 1) FROM tab2")
111.5
補足: 四捨五入関数は未完じゃないでしょうか？
上でも sgn関数を使っていますが、これを忘れるとトンデモない結果を得ると思いますよ。
質問者の関数と以下に示すRounds関数との実行結果の違いを確認されて下さい。
? Rounds(-5555.555, 0, 2)
-5555.56
? MyRound(5555.555, 2)
5555.56
? MyRound(-5555.555, 2)
-5555.55
なお、以下は、ADOでAccessのデータを参照するDBLookup関数と四捨五入、切り捨て、切り上げを行う関数です。
これらの関数で持って十分にテストを重ねられたがいいかもです。
ともかく、 Round(fld_1 + 0.01 * sgn(fld_1), 1) なんてやり方は今考えたばかりだからです。
? Rounds(DBLookup("SELECT fld_1 FROM tab2"), 0, 2)
111.45
? Rounds(DBLookup("SELECT fld_1 FROM tab2"), 0, 1)
111.5
こういう結果と一致すれば、 Round(fld_1 + 0.01 * sgn(fld_1), 1)もバグっていません。
しかし、この検証は上述の一回だけのテスト。
そこは、質問者で行って下さい。
'
' ADO 接続文字列
'
Public Const pubCNNSTRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Temp\DB4.mdb"
'
' Rounds関数用
'
Public Const 四捨五入 = 0
Public Const 切り捨て = 1
Public Const 切り上げ = 2
Public Function DBLookup(ByVal strQuerySQL As String) As Variant
On Error GoTo Err_DBLookup
Dim DataValue
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
With rst
.Open strQuerySQL, _
pubCNNSTRING, _
adOpenStatic, _
adLockReadOnly
If Not .BOF Then
.MoveFirst
DataValue = .Fields(0)
End If
End With
Exit_DBLookup:
On Error Resume Next
rst.Close
Set rst = Nothing
DBLookup = DataValue
Exit Function
Err_DBLookup:
MsgBox "SELECT 文の実行時にエラーが発生しました。(DBLookup)" & Chr$(13) & Chr$(13) & _
"・Err.Description=" & Err.Description & Chr$(13) & _
"・SQL Text=" & strQuerySQL, _
vbExclamation, " 関数エラーメッセージ"
Resume Exit_DBLookup
End Function
Public Function Rounds(ByVal M As Currency, _
ByVal A As Integer, _
Optional D As Integer = 0) As Variant
Rounds = Sgn(M) * Fix(Abs(M) * 10 ^ D + Abs((A = 0) * 0.5@ + (A = 2) * (Int(M * 10 ^ D) <> (M * 10 ^ D)))) / 10 ^ D
End Function
Public Function MyRound(X As Currency, s As Integer) As Currency
Dim t As Integer
t = 10 ^ Abs(s)
If s > 0 Then
MyRound = Int(X * t + 0.5) / t
Else
MyRound = Int(X / t + 0.5) * t
End If
End Function
