VB6将分数转换为小数和将小数转换为分数

有几篇文章是关于这个的，但似乎没有一篇能提供完整的代码解决方案，所以我把这篇文章贴出来，这篇文章是从互联网上各种各样的想法中挑选出来的（并在适当的情况下记入）。VB6没有任何将分数转换为十进制数的函数，这是我正在进行的一个与膳食食谱有关的项目所需要的。我曾考虑在.NET中编写一个DLL并将其插入到我的应用程序中，但最终决定采用这种方法。我希望这对其他人有用。以下解决方案将执行以下操作：

您提供一个十进制数，将以字符串形式返回分数

您提供一个分数作为字符串，并将返回十进制数

在这两种情况下，整数都被计算，例如“2 3/4”（2和3/4）或“2.75”

---

我确信代码效率不高，因此欢迎进行任何改进。

将其复制/粘贴为新的类模块：

Option Explicit

Private ErrorNote As String

'Properties
Public Property Get GetAsFraction(numToConvert As Double) As String

        On Error GoTo GetAsFraction_Error

        GetAsFraction = FncGetAsFraction(numToConvert)

        On Error GoTo 0

        Exit Property

GetAsFraction_Error:

        ErrorNote = "Number:" & Err.number & " (" & Err.Description & ") in procedure 'GetAsFraction' in 'ClsFractionDecimal'"
        MsgBox (ErrorNote)

End Property

Public Property Get GetAsDecimal(fractionString As String) As Double

        On Error GoTo GetAsDecimal_Error

        GetAsDecimal = FncGetAsDecimal(fractionString)

        On Error GoTo 0

        Exit Property

GetAsDecimal_Error:

        ErrorNote = "Number:" & Err.number & " (" & Err.Description & ") in procedure 'GetAsDecimal' in 'ClsFractionDecimal'"
        MsgBox (ErrorNote)

End Property

'Functions - private
Private Function FncGetAsDecimal(fractionToConvert As String) As Double

        Dim result As Double
        Dim wholeNumber As Integer
        Dim splitStr As Variant
        Dim numerator As Integer
        Dim denominator As Integer
        Dim fractionString As String
        Dim dividedByPos As Integer

        On Error GoTo FncGetAsDecimal_Error

        splitStr = Split(fractionToConvert, " ")

        If UBound(splitStr) = 1 Then

            wholeNumber = splitStr(0)
            fractionString = splitStr(1)

        Else

            fractionString = splitStr(0)

        End If

        dividedByPos = InStr(1, fractionString, "/")

        numerator = Left(fractionString, dividedByPos - 1)
        denominator = Mid(fractionString, dividedByPos + 1)

        result = Val(numerator) / Val(denominator) + wholeNumber

       FncGetAsDecimal = result

       On Error GoTo 0

       Exit Function

FncGetAsDecimal_Error:

       ErrorNote = "Number:" & Err.number & " (" & Err.Description & ") in procedure 'FncGetAsDecimal' in 'ClsFractionDecimal'"
       MsgBox (ErrorNote)

End Function

Private Function FncGetAsFraction(numToConvert As Double) As String

        Dim result As String
        Dim numeratorCount As Integer
        Dim denominator As Single
        Dim multiplierStr As String
        Dim i As Integer
        Dim fractionNum As Single
        Dim lowestCommonDenominator As Long
        Dim wholeNumber As Integer
        Dim decimalPos As Integer

        On Error GoTo FncGetAsFraction_Error

        If numToConvert > 0 Then

            decimalPos = InStr(1, CStr(numToConvert), ".")

            If decimalPos > 1 Then

                wholeNumber = CStr(Mid(numToConvert, 1, decimalPos - 1))
                numToConvert = CStr(Mid(numToConvert, decimalPos))

            End If

            numeratorCount = FncCountDecimalPlaces(numToConvert)
            multiplierStr = "1"

           For i = 1 To numeratorCount

               multiplierStr = multiplierStr & "0"

           Next i

           fractionNum = numToConvert * Val(multiplierStr)
           denominator = 1 * Val(multiplierStr)

               result = FncCrunchFraction(fractionNum, denominator)
               If result = "" Then result = fractionNum & "/" & denominator
               If wholeNumber <> 0 Then result = wholeNumber & " " & result

       Else

           result = "ERROR"

       End If

       FncGetAsFraction = result

       On Error GoTo 0

       Exit Function

FncGetAsFraction_Error:

       ErrorNote = "Number:" & Err.number & " (" & Err.Description & ") in procedure 'FncGetAsFraction' in 'ClsFractionDecimal'"
       MsgBox (ErrorNote)

End Function

Private Function FncCountDecimalPlaces(num As Double) As Integer

        Dim result As Integer
        Dim numberStr As String
        Dim i As Integer
        Dim decimalPointPos As Integer

        On Error GoTo FncCountDecimalPlaces_Error

        numberStr = CStr(num)

        If Len(numberStr) > 0 Then

            i = 1

            Do While i <= Len(numberStr) And decimalPointPos = 0

                If Mid(numberStr, i, 1) = "." Then decimalPointPos = i
                i = i + 1

            Loop

        End If

        If i > 1 Then

           result = (Len(numberStr) - i + 1)

       End If

       FncCountDecimalPlaces = result

       On Error GoTo 0

       Exit Function

FncCountDecimalPlaces_Error:

       ErrorNote = "Number:" & Err.number & " (" & Err.Description & ") in procedure 'FncCountDecimalPlaces' in 'ClsFractionDecimal'"
       MsgBox (ErrorNote)

End Function

'Credit to:
'http://www.tek-tips.com/viewthread.cfm?qid=206890
'dsi (Programmer) - 7 Feb 02 10:38
Private Function FncCrunchFraction(num1 As Single, num2 As Single) As String

        Dim num As Single
        Dim dem As Single
        Dim cnt1 As Integer
        Dim cnt2 As Integer
        Dim numFactors() As Single
        Dim demFactors() As Single
        Dim common As Single
        Dim i As Integer
        Dim j As Integer

        On Error GoTo FncCrunchFraction_Error

        num = num1
        dem = num2

        For i = 2 To Int(num / 2) Step 1

            If (num Mod i = 0) Then

                cnt1 = cnt1 + 1
                ReDim Preserve numFactors(1 To cnt1)
                numFactors(cnt1) = i

            End If

        Next i

        cnt1 = cnt1 + 1

        ReDim Preserve numFactors(1 To cnt1)
       numFactors(cnt1) = num

       For i = 2 To Int(dem / 2) Step 1

           If (dem Mod i = 0) Then

                cnt2 = cnt2 + 1
                ReDim Preserve demFactors(1 To cnt2)
                demFactors(cnt2) = i

            End If

        Next i

        cnt2 = cnt2 + 1
        ReDim Preserve demFactors(1 To cnt2)
        demFactors(cnt2) = dem

        For i = cnt1 To 1 Step -1

            For j = cnt2 To 1 Step -1

                If (numFactors(i) = demFactors(j)) Then

                    common = numFactors(i)
                    FncCrunchFraction = num / common & "/" & dem / common
                    Exit Function

                End If

            Next j

        Next i

        FncCrunchFraction = ""

        On Error GoTo 0

        Exit Function

FncCrunchFraction_Error:

        ErrorNote = "Line:" & Erl & " Number:" & Err.number & " (" & Err.Description & ") in procedure 'FncCrunchFraction' in 'ClsFractionDecimal'"
        MsgBox (ErrorNote)

End Function

---

我刚刚注意到它不进行任何舍入，所以三分之一（如1/3）显示为30/100。真烦人。

    Public Function DecimalToFraction(number As Double) As String

    Dim myFractionDecimal As New ClsFractionDecimal

    DecimalToFraction = myFractionDecimal.GetAsFraction(number)

    Set myFractionDecimal = Nothing

End Function

Public Function FractionToDecimal(fractionString As String) As Double

    Dim myFractionDecimal As New ClsFractionDecimal

    FractionToDecimal = myFractionDecimal.GetAsDecimal(fractionString)

    Set myFractionDecimal = Nothing

End Function