Converting Decimals to Fractions

I have a function that will convert a decimal number into a fraction, but the output is a string, not a number. The output is accurate to 1/128th of an inch.

'*******************Begin Code******************
Public Function DecimalToFraction(x)
Dim Temp As String
Dim Fixed As Double

If (VarType(x) < 2) Or (VarType(x) > 6) Then
DecimalToFraction = x
Else
x = Abs(x)
Fixed = Int(x)
If Fixed > 0 Then
Temp = str(Fixed)
End If
Select Case x - Fixed
Case Is < 0.007813
If Fixed > 0 Then
Temp = Temp
Else
Temp = str(x)
End If
Case 0.007813 To 0.023438
Temp = Temp + " 1/64"
Case 0.023438 To 0.039063
Temp = Temp + " 1/32"
Case 0.039063 To 0.054688
Temp = Temp + " 3/64"
Case 0.054688 To 0.070313
Temp = Temp + " 1/16"
Case 0.070313 To 0.085938
Temp = Temp + " 5/64"
Case 0.085938 To 0.101563
Temp = Temp + " 3/32"
Case 0.101563 To 0.117188
Temp = Temp + " 7/64"
Case 0.117188 To 0.132813
Temp = Temp + " 1/8"
Case 0.132813 To 0.148438
Temp = Temp + " 9/64"
Case 0.148438 To 0.164063
Temp = Temp + " 5/32"
Case 0.164063 To 0.179688
Temp = Temp + " 11/64"
Case 0.179688 To 0.195313
Temp = Temp + " 3/16"
Case 0.195313 To 0.210938
Temp = Temp + " 13/64"
Case 0.210938 To 0.226563
Temp = Temp + " 7/32"
Case 0.226563 To 0.242188
Temp = Temp + " 15/64"
Case 0.242188 To 0.257813
Temp = Temp + " 1/4"
Case 0.257813 To 0.273438
Temp = Temp + " 17/64"
Case 0.273438 To 0.289063
Temp = Temp + " 9/32"
Case 0.289063 To 0.304688
Temp = Temp + " 19/64"
Case 0.304688 To 0.320313
Temp = Temp + " 5/16"
Case 0.320313 To 0.335938
Temp = Temp + " 21/64"
Case 0.335938 To 0.351563
Temp = Temp + " 11/32"
Case 0.351563 To 0.367188
Temp = Temp + " 23/64"
Case 0.367188 To 0.382813
Temp = Temp + " 3/8"
Case 0.382813 To 0.398438
Temp = Temp + " 25/64"
Case 0.398438 To 0.414063
Temp = Temp + " 13/32"
Case 0.414063 To 0.429688
Temp = Temp + " 27/64"
Case 0.429688 To 0.445313
Temp = Temp + " 7/16"
Case 0.445313 To 0.460938
Temp = Temp + " 29/64"
Case 0.460938 To 0.476563
Temp = Temp + " 15/32"
Case 0.476563 To 0.492188
Temp = Temp + " 31/64"
Case 0.492188 To 0.507813
Temp = Temp + " 1/2"
Case 0.507813 To 0.523438
Temp = Temp + " 33/64"
Case 0.523438 To 0.539063
Temp = Temp + " 17/32"
Case 0.539063 To 0.554688
Temp = Temp + " 35/64"
Case 0.554688 To 0.570313
Temp = Temp + " 9/16"
Case 0.570313 To 0.585938
Temp = Temp + " 37/64"
Case 0.585938 To 0.601563
Temp = Temp + " 19/32"
Case 0.601563 To 0.617188
Temp = Temp + " 39/64"
Case 0.617188 To 0.632813
Temp = Temp + " 5/8"
Case 0.632813 To 0.648438
Temp = Temp + " 41/64"
Case 0.648438 To 0.664063
Temp = Temp + " 21/32"
Case 0.664063 To 0.679688
Temp = Temp + " 43/64"
Case 0.679688 To 0.695313
Temp = Temp + " 11/16"
Case 0.695313 To 0.710938
Temp = Temp + " 45/64"
Case 0.710938 To 0.726563
Temp = Temp + " 23/32"
Case 0.726563 To 0.742188
Temp = Temp + " 47/64"
Case 0.742188 To 0.757813
Temp = Temp + " 3/4"
Case 0.757813 To 0.773438
Temp = Temp + " 49/64"
Case 0.773438 To 0.789063
Temp = Temp + " 25/32"
Case 0.789063 To 0.804688
Temp = Temp + " 51/64"
Case 0.804688 To 0.820313
Temp = Temp + " 13/16"
Case 0.820313 To 0.835938
Temp = Temp + " 53/64"
Case 0.835938 To 0.851563
Temp = Temp + " 27/32"
Case 0.851563 To 0.867188
Temp = Temp + " 55/64"
Case 0.867188 To 0.882813
Temp = Temp + " 7/8"
Case 0.882813 To 0.898438
Temp = Temp + " 57/64"
Case 0.898438 To 0.914063
Temp = Temp + " 29/32"
Case 0.914063 To 0.929688
Temp = Temp + " 59/64"
Case 0.929688 To 0.945313
Temp = Temp + " 15/16"
Case 0.945313 To 0.960938
Temp = Temp + " 61/64"
Case 0.960938 To 0.976563
Temp = Temp + " 31/32"
Case 0.976563 To 0.992188
Temp = Temp + " 63/64"
Case Is > 0.992188
Temp = str(Int(x) + 1)
End Select

DecimalToFraction = Temp

End If
End Function
'*******************End Code******************

HTH
RDH



[This message has been edited by R. Hicks (edited 02-11-2001).]
I plugged your code into an Access2019 db, and followed your instructions...it works beautifully, THANKS!
 
I'm going to stick with my suggestion to use a table rather than a case statement but thanks for the list of conversions.
 
Here's shorter code...
Code:
Function GetFraction(ByVal Number As Single, Denominator As Integer) As String
    Dim i As Integer
    
    Number = RoundToNearest(Number, 1 / Denominator)
    
    If Number <= 0 Or Number >= 1 Then
        Err.Raise 5, "GetFraction()", "Number must be between zero and one"
    Else
        For i = 1 To Denominator - 1
            If CInt(i / Number) = i / Number Then
                GetFraction = i & "/" & i / Number
                Exit For
            End If
        Next
    End If
End Function

Function RoundToNearest(Number As Single, Optional RoundTo As Single = 1)
    RoundToNearest = CLng(Number / RoundTo) * RoundTo
End Function
You can specify precision with the denominator parameter.
 
As @MarkK pointed out there is no need for a table or a select case. This can be solved in closed form using the Euclidean Algorithm for finding greatest common divisor. There are several forms of the algorithm. There is a subtraction method, division method, and the recursive which is shown. The only trick is you have to define the accuracy (precision to which to report your denominator).

Here is another version with a couple of additional features. You can do compound values with whole numbers and fraction parts. Also you can return the whole portion, numerator, and denominator instead of simply a string.

Code:
Public Type Fraction
  WholeNumber As Long
  Numerator As Long
  Denominator As Long
End Type
Public Function GetFraction(ByVal TheDecimal As Double, Optional ByVal Accuracy As Double = 0.0078125) As Fraction
  'Lets go 10 places
  Const places = 1000000000
  Dim GCD As Long
  Dim decimalPart As Double
  GetFraction.WholeNumber = Fix(TheDecimal)
  decimalPart = TheDecimal - GetFraction.WholeNumber
  decimalPart = Accuracy * CLng(decimalPart / Accuracy)
  GetFraction.Numerator = Fix(decimalPart * places)
  GetFraction.Denominator = places
  GCD = GetGCD(GetFraction.Numerator, GetFraction.Denominator)
  GetFraction.Numerator = GetFraction.Numerator / GCD
  GetFraction.Denominator = GetFraction.Denominator / GCD
End Function
Public Function GetGCD(ByVal a As Long, ByVal b As Long) As Long
    Do While a <> b
        If a > b Then
            a = a - b
        Else
            b = b - a
        End If
    Loop
    GetGCD = a
End Function
Public Function GetFractionToString(TheDecimal As Double, Optional Accuracy As Double = 0.0078125) As String
  Dim TheFraction As Fraction
  TheFraction = GetFraction(TheDecimal, Accuracy)
  GetFractionToString = CStr(TheFraction.Numerator) & "/" & CStr(TheFraction.Denominator)
  If TheFraction.WholeNumber <> 0 Then GetFractionToString = TheFraction.WholeNumber & " " & GetFractionToString
End Function

Public Sub tet()
 Dim x As Double
 Dim acc As Double
 acc = 1 / 8
 x = 3 + 1 / 2
 Debug.Print GetFractionToString(x, acc)
End Sub
 
As @MarkK pointed out there is no need for a table or a select case.
this won't do, on your test try x=3.021
you'll end up in never ending loop.

the original Function on this thread is about converting decimal inches
to fraction equivalent. not any number system. that's is why there is 1/64", etc.
that is why my sample is to put the data in table.

getting back to the Test sub, it is still running...
 
My turn. Here's a function that converts centigrade to celsius:

Code:
Public Function to_Celsius(ByVal in_Centigrade As Double) As Double
' converts Centigrade temperature to Celsius

    Dim ret As Double                   ' return value
    Dim int_Counter As Integer          ' counter variable for looping to calculate Celsius value
    Dim int_CounterMax As Integer       ' maximum value of Counter for looping
    Dim int_Decimal As String           ' determines where decimal point is in in_Centigrade

    ret = 0
    ' default return value

    int_CounterMax = Int(Abs(in_Centigrade))
    ' gets positive integer part of Centigrade so can loop and get Celsius

    int_Decimal = InStr(in_Centigrade, ".")
    If int_Decimal > 0 Then
      ' Centigrade has decimal value, will extract it to return value
      ret = Mid(in_Centigrade, int_Decimal) * 1
    End If

    If (in_Centigrade < 0) Then
       ' submitted value is less than 0, will compute Celsius for it
        For int_Counter = 1 To int_CounterMax
            ret = ret + 1
        Next
        ret = ret * -1
    End If

    If (in_Centigrade > 1) Then
    ' submitted value is more than 1, will compute Celsius for it
        int_Counter = 2 * int_CounterMax
        Do While int_Counter > int_CounterMax
            ret = ret + 1
            int_Counter = int_Counter - 1
        Loop
    End If

    to_Celsius = ret

End Function

Discuss and try and outdo, but hold any thanks until 2029 so that we can revisit this then.
 
this won't do, on your test try x=3.021
you'll end up in never ending loop.

the original Function on this thread is about converting decimal inches
to fraction equivalent. not any number system. that's is why there is 1/64", etc.
that is why my sample is to put the data in table.
It does not matter if you want fractional inches, meters, centimeters etc. Something measured to 1/64th or 1/32 has nothing to do with units.

If you set your accuracy to 128 then you will get fractional values measured to 1/128th accuracy, but you can set it to 1/64, 1/32, 1/16 etc. You can call it fractional inches or whatever you want. And since these can all be further reduced you will get values like 1/2, x/3, x/4, x/16, x/32, x/64

I did not test his version but mine does not go into a loop, unless the accuracy is bigger than then fractional value. So I put in an error check for that.

Code:
Public Sub tet()
Dim X As Double
Dim acc As Double
acc = 1 / 64
X = 3.021
Debug.Print GetFractionToString(X, acc)
End Sub
returns
3 1/64
if I am measuring more exact to 128 th then i get
3 3/128

Code:
Public Function GetFraction(ByVal TheDecimal As Double, Optional ByVal Accuracy As Double = 0.0078125) As Fraction
  'Lets go 10 places
  Const places = 1000000000
  Dim GCD As Long
  Dim decimalPart As Double
  GetFraction.WholeNumber = Fix(TheDecimal)
  decimalPart = TheDecimal - GetFraction.WholeNumber
  If Accuracy > decimalPart Then
    MsgBox "Accuracy greater than decimal. Changing to 1/128th"
    Accuracy = 1 / 128
    If Accuracy > decimalPart Then
      MsgBox "Your measurement is very small round up to accuracy or reset accuracy"
      Exit Function
    End If
  End If
  decimalPart = Accuracy * CLng(decimalPart / Accuracy)
  GetFraction.Numerator = Fix(decimalPart * places)
  GetFraction.Denominator = places
  GCD = GetGCD(GetFraction.Numerator, GetFraction.Denominator)
  GetFraction.Numerator = GetFraction.Numerator / GCD
  GetFraction.Denominator = GetFraction.Denominator / GCD
End Function
 
Last edited:
X = 3.9999
As written my code returns
3 1/1
which although technically correct does not read well. So here is an update.
Code:
Public Type Fraction
  WholeNumber As Long
  Numerator As Long
  Denominator As Long
End Type
Public Function GetFraction(ByVal TheDecimal As Double, Optional ByVal Accuracy As Double = 0.0078125) As Fraction
  'Lets go 10 places
  Const places = 1000000000
  Dim GCD As Long
  Dim decimalPart As Double
  GetFraction.WholeNumber = Fix(TheDecimal)
  decimalPart = TheDecimal - GetFraction.WholeNumber
  If Accuracy > decimalPart Then
    MsgBox "Accuracy greater than decimal. Changing to 1/128th"
    Accuracy = 1 / 128
    If Accuracy > decimalPart Then
      MsgBox "Your measurement is very small round up to accuracy or reset accuracy"
      Exit Function
    End If
  End If
  decimalPart = Accuracy * CLng(decimalPart / Accuracy)
  GetFraction.Numerator = Fix(decimalPart * places)
  GetFraction.Denominator = places
  GCD = GetGCD(GetFraction.Numerator, GetFraction.Denominator)
  GetFraction.Numerator = GetFraction.Numerator / GCD
  GetFraction.Denominator = GetFraction.Denominator / GCD
  If GetFraction.Denominator = GetFraction.Numerator Then
    GetFraction.WholeNumber = GetFraction.WholeNumber + 1
    GetFraction.Numerator = 0
  End If
End Function
Public Function GetGCD(ByVal a As Long, ByVal b As Long) As Long
    Do While a <> b
        If a > b Then
            a = a - b
        Else
            b = b - a
        End If
    Loop
    GetGCD = a
End Function
Public Function GetFractionToString(TheDecimal As Double, Optional Accuracy As Double = 0.0078125) As String
  Dim TheFraction As Fraction
  TheFraction = GetFraction(TheDecimal, Accuracy)
  If TheFraction.Numerator = 0 Then
    GetFractionToString = CStr(TheFraction.WholeNumber)
  Else
    GetFractionToString = CStr(TheFraction.Numerator) & "/" & CStr(TheFraction.Denominator)
    If TheFraction.WholeNumber <> 0 Then GetFractionToString = TheFraction.WholeNumber & " " & GetFractionToString
  End If
End Function

Public Sub tet()
 Dim X As Double
 Dim acc As Double
 acc = 1 / 128
 X = 3.99999
 Debug.Print GetFractionToString(X, acc)
End Sub
Returns 4
 
To verify using @arnelgp data

Code:
SELECT
 conversionTable.[Decimal Inches],
 conversionTable.[Fraction Inches],
 GetFractionToString([decimal inches]) AS MajP_Fraction
FROM conversionTable;
Query1 Query1

Decimal InchesFraction InchesMajP_Fraction
0.015625​
1⁄64"1/64
0.03125​
1⁄32"1/32
0.046875​
3⁄64"3/64
0.0625​
1⁄16"1/16
0.078125​
5⁄64"5/64
0.09375​
3⁄32"3/32
0.109375​
7⁄64"7/64
0.125​
1⁄8"1/8
0.140625​
9⁄64"9/64
0.15625​
5⁄32"5/32
0.171875​
11⁄64"11/64
0.1875​
3⁄16"3/16
0.203125​
13⁄64"13/64
0.21875​
7⁄32"7/32
0.234375​
15⁄64"15/64
0.25​
1⁄4"1/4
0.265625​
17⁄64"17/64
0.28125​
9⁄32"9/32
0.296875​
19⁄64"19/64
0.3125​
5⁄16"5/16
0.328125​
21⁄64"21/64
0.34375​
11⁄32"11/32
0.359375​
23⁄64"23/64
0.375​
3⁄8"3/8
0.390625​
25⁄64"25/64
0.40625​
13⁄32"13/32
0.421875​
27⁄64"27/64
0.4375​
7⁄16"7/16
0.453125​
29⁄64"29/64
0.46875​
15⁄32"15/32
0.484375​
31⁄64"31/64
0.5​
1⁄2"1/2
0.515625​
33⁄64"33/64
0.53125​
17⁄32"17/32
0.546875​
35⁄64"35/64
0.5625​
9⁄16"9/16
0.578125​
37⁄64"37/64
0.59375​
19⁄32"19/32
0.609375​
39⁄64"39/64
0.625​
5⁄8"5/8
0.640625​
41⁄64"41/64
0.65625​
21⁄32"21/32
0.671875​
43⁄64"43/64
0.6875​
11⁄16"11/16
0.703125​
45⁄64"45/64
0.71875​
23⁄32"23/32
0.734375​
47⁄64"47/64
0.75​
3⁄4"3/4
0.765625​
49⁄64"49/64
0.78125​
25⁄32"25/32
0.796875​
51⁄64"51/64
0.8125​
13⁄16"13/16
0.828125​
53⁄64"53/64
0.84375​
27⁄32"27/32
0.859375​
55⁄64"55/64
0.875​
7⁄8"7/8
0.890625​
57⁄64"57/64
0.90625​
29⁄32"29/32
0.921875​
59⁄64"59/64
0.9375​
15⁄16"15/16
0.953125​
61⁄64"61/64
0.96875​
31⁄32"31/32
0.984375​
63⁄64"63/64
1​
1"1
 
So the question may be if you should use a table of values or a function to do this.

For speed and efficiency you should use a table.
Pros:
very fast in a query
Cons:
you can make mistakes
takes a while to populate
limited to a specific accuracty

Function
Pros: Flexible to support any accuracy
do not have to input lots of information where mistakes are possible
Cons: any UDF is slower than pure SQL. OK for single value not OK for thousands of values.
 
So the question may be if you should use a table of values or a function to do this.

For speed and efficiency you should use a table.
Pros:
very fast in a query
Cons:
you can make mistakes
takes a while to populate
limited to a specific accuracty

Function
Pros: Flexible to support any accuracy
do not have to input lots of information where mistakes are possible
Cons: any UDF is slower than pure SQL. OK for single value not OK for thousands of values.

So given the above, presumably store the conversion table(s) of the required accuracy, and populate it carefully with a one-time process.
 
So given the above, presumably store the conversion table(s) of the required accuracy, and populate it carefully with a one-time process
If speed is an issue I would guess so. Lets say you have a table for 100k measurements and want to convert then the table would be very fast.
If you are calculating and reducing the fractions dynamically they all use some version of Euclids Algorithm for greatest common divisor. There are several implementations, but all have loops or recursion. So I put a counter in to print how many loops using the data in post 34. You can see the function loops from 3 to 63 times for the below. So without trying a large dataset, I am assuming it could be slow although they are very simple loops.
63
31
23
15
16
12
15
7
15
9
11
7
16
8
10
3
 
on my new db it is returning 3-63/64 (64 graduation).
this is consistent on my qryRange.
3 63/64 = 3.984375 a difference of .015624 from 3.999999
so 4 is a more accurate answer with a difference of .000001
 

Users who are viewing this thread

Back
Top Bottom