我自己编的，可能大家有时会用上，函数小数转分数，限于整除分数，如1/8，5/4等

新客网 XKER.COM 2003-07-11 来源： 收藏本文

'函数实现小数转分数
Public Function XtoF(str As Currency, Optional fenm As Integer = 32) As String '只限于整除分数
   Dim Cfm As Currency
   Dim cfmmod As Integer
   On Error GoTo Erroreof
   
   Cfm = 1 / fenm
   XtoF = ""
   If str = 0 Then XtoF = "": Exit Function
   
   Dim point As Integer
   Dim dInt As String
   Dim dPoint As Currency
   Dim fint, fint1, fint2 As Integer
   If str <> 0 Then
        If str > 1 Then
            point = InStr(1, str, ".", 1)
            If point = 0 Then
                XtoF = str:
                Exit Function
            Else
                dInt = Mid(str, 1, point - 1)
                dPoint = CCur("0." & Mid(str, point + 1))
                fint = InStr(1, XtoF(dPoint), "/", 1)
                fint1 = CInt(Mid(XtoF(dPoint), 1, fint - 1))
                fint2 = CInt(Mid(XtoF(dPoint), fint + 1))
                
                XtoF = CStr(dInt * fint2 + fint1) & "/" & CStr(fint2)
           
            End If
        Else
           If fenm Mod CInt(str / Cfm) = 0 Then
            XtoF = "1/" + CStr(fenm / CInt(str / Cfm))
           Else
              cfmmod = Maxgys(fenm, CInt(str / Cfm))
            XtoF = CStr(CInt(str / Cfm / cfmmod)) + "/" + CStr(CInt(fenm / cfmmod))
           End If
        End If
   Else
       XtoF = "0"
   End If
   Exit Function
Erroreof:
   XtoF = ""
End Function
Function Maxgys(num1 As Integer, num2 As Integer) As Integer
    Dim minnum, i As Integer
    minnum = num1
    If num1 > num2 Then minnum = num2
    For i = 1 To minnum
     If ((num1 Mod i) = 0) And ((num2 Mod i) = 0) Then Maxgys = i

  
    Next i
End Function

• ·ASP+ACCESS数据库中文乱码问题解决
• ·编程实例 字母+数字验证码程序
• ·ASP连接数据库错误解决办法新法
• ·初学:ASP内建对象Response
• ·ASP网站Server object error的解决办法
• ·ASP技巧：让Len,Left,Right函数识别中文
• ·把网页中的电话号码生成图片的ASP程序
• ·ASP如何实现IE地址栏参数的判断
• ·细化解析：ASP连接11种数据库语法集锦
• ·ASP实现网页打开任何类型文件都保存
• ·ASP代码直接增加、删除ACCESS表和字段
• ·ASP：判断访问是否来自搜索引擎的函数
• ·ASP技巧：禁用页面缓存的五种方法
• ·学习ASP关于与变量子类型相关的函数
• ·ASP开发中的(VBScript)类基础学习
• ·ASP访问Excel文件