Access技巧接龙

Trynew

ceiling函数  是Excel中的向上舍入函数，可以在引用Excel对象库后使用(包括其它Excel中的函数)，如msgbox Excel.WorksheetFunction.Ceiling(129.99,0.05)另外也可以在Access中自定义：Public Function Ceiling(Num As Double, Sign As Double) As Double

    Dim intDot As Integer

    intDot = IIf(InStr(Sign, ".") = 0, 0, Len(Sign) - InStr(Sign, "."))

    Num = Int(Num * 10 ^ intDot)

    Sign = Sign * 10 ^ intDot

    Ceiling = (Num + IIf(Num Mod Sign = 0, 0, Sign) - (Num Mod Sign)) / 10 ^ intDot

End Function

Trynew

下面的程序效率不是很高，但超大整数乘法、加法的函数还是比较实用

Public Function factorial(num As Integer) As String

    factorial = "1"

    For num = num To 1 Step -1

        factorial = strMult(factorial, Trim(Str(num)))

    Next

End Function'1000 的阶乘=40238726007709377354370243392300398571937...用时6分钟

'超大整数乘法 （需调用下面的strAdd、strPlus自定义函数）

Public Function strMult(str1 As String, str2 As String) As String

    Dim i As Integer

    If Len(str2) = 1 Then

        strMult = IIf(str2 = "0", "", str1)

        For i = 1 To Val(str2) - 1

            strMult = strAdd(strMult, str1)

        Next

    Else

        strMult = strAdd(strMult(str1, Right(str2, 1)), strMult(str1 & "0", Left(str2, Len(str2) - 1)))

    End If

End Function'超大整数加法 （需调用下面的strPlus自定义函数）

Public Function strAdd(str1 As String, str2 As String) As String

    If Len(str1) < Len(str2) Then

        strAdd = strAdd(str2, str1)

    Else

        Dim num As Long

        strAdd = strPlus(str1, "", Val(Right(str2, 1)))

        For num = 1 To Len(str2) - 1

            strAdd = strPlus(Left(strAdd, Len(strAdd) - num), Right(strAdd, num), Val(Mid(str2, Len(str2) - num, 1)))

        Next

    End If

End FunctionPublic Function strPlus(str1 As String, str2 As String, num As Integer) As String

    If Len(str1) = 1 Then

        strPlus = (Val(str1) + num) & str2

    Else

        num = Val(Right(str1, 1)) + num

        If num < 10 Then

            strPlus = Left(str1, Len(str1) - 1) & num & str2

        Else

            strPlus = strPlus(Left(str1, Len(str1) - 1), (num Mod 10) & str2, 1)

        End If

    End If

End Function

Trynew

以下是引用lanchong在2005-4-12 15:10:00的发言：
谁帮写个清除空格的函数，不管空格在字段何处，通通清除

可以直接使用string=Replace(string," ",""),要连全角的空格也清除可以这样：

?　replace(replace(" 123　123 qwer qwer ｑｗｅｒ　ｑｗｅｒ  ",chr(32),""),chr(-24159),"")

Trynew

Public Function jjos(x As Double, m As Integer, n As Integer)
'// **“四舍六入，逢五奇进偶舍”自定义函数过程 **

'// 函数形式 jjos(x,m,n) ,返回值ret_jjos为 Decimal 型

'// x为操作数值, m为最多保留小数位数,n为有效数字位数

'// m、n皆为 Integer 型

'// m = 0 表示取整数,n = 0 表示对有效数字无要求

Dim i As Integer, ret_jjos As Double, j As Integer


j = 1

If x < 0 Then j = -1  ' //j用于记忆是正数还是负数

If n > 0 Then

Do While Abs(x) >= 10 ^ (n - m)

     x = x / 10    '//向前移动一个小数点

     i = i + 1

Loop

End If

If Int(x * 10 ^ (m + 1)) = x * 10 ^ (m + 1) Then

    x = Round(x, m + 2)

    ret_jjos = Val(Left(Right(Str(x), 3), 1))

    If Right(Str(x), 2) = "50" And Int(ret_jjos / 2) = ret_jjos / 2 Then

        ret_jjos = Int(x / 10 ^ m) * 10 ^ i '//唯一此种情况舍

    Else

        ret_jjos = Round(x, m) * 10 ^ i '//不是那种情况执行四舍五入

    End If

Else

    ret_jjos = Round(x, m) * 10 ^ i  ' //其它情况执行四舍五入

End If

If n > 0 Then

    If Int(ret_jjos) >= 10 ^ (n - 1) Then

        ret_jjos = Int(ret_jjos)

    ElseIf Abs(ret_jjos) >= 1 Then

        ret_jjos = Val(Left(Str(Abs(ret_jjos)), n + 1)) * j

    End If

End If

jjos = ret_jjos  '//返回处理结果


End Function