[Tasos]

Καλησπέρα σε όλους!

Η συνάρτηση ConvertDecimalToFraction επιστρέφει κατά βούληση τον ακέραιο χωριστά και το δεκαδικό κομμάτι ενός αριθμού σε κλάσμα.

Για παράδειγμα χρήσης με την τιμή 3,333 από πεδίο φόρμας ή έκθεσης:

=ConvertDecimalToFraction(3,123) επιστρέφει 3 123/1000
ή
=ConvertDecimalToFraction(3,123;2) επιστρέφει 3 3/25
ή
=ConvertDecimalToFraction(3,123;2;False) επιστρέφει 78/25

Όλα τα ορίσματα στη συνάρτηση εκτός από το πρώτο είναι προαιρετικά.

Option Compare Database
Option Explicit

Private Function GetDecimalSeparator()
    If Int("1,5") = 1 Then
        GetDecimalSeparator = ","
    Else
        GetDecimalSeparator = "."
    End If
End Function

Public Function ConvertDecimalToFraction(DecimalValue As Variant, _
                                         Optional NumDigitsAfterDecimal As Integer = -1, _
                                         Optional UseWholePartSeperratly As Boolean = True) As String

    Dim DecCount As Integer
    Dim DivParts As Double
    Dim UPart As Long
    Dim LPart As Long
    Dim WholeNumber As Double
    Dim Sep As String

    If IsNull(DecimalValue) Then
        ConvertDecimalToFraction = vbNullString
        Exit Function
    End If

    Sep = GetDecimalSeparator

    UPart = 1
    LPart = 1

    If NumDigitsAfterDecimal > -1 Then
        DecimalValue = Round(DecimalValue, NumDigitsAfterDecimal)
    End If

    WholeNumber = Int(DecimalValue)

    If WholeNumber = DecimalValue Then
        ConvertDecimalToFraction = DecimalValue
        Exit Function
    Else
        DecCount = Len(Split(CStr(DecimalValue), Sep)(1))
    End If
    If UseWholePartSeperratly Then
        DecimalValue = Round(DecimalValue - WholeNumber, DecCount)
    End If
    DivParts = UPart / LPart

    While (DivParts <> DecimalValue)
        If (DivParts < DecimalValue) Then
            UPart = UPart + 1
        Else
            LPart = LPart + 1
            UPart = DecimalValue * LPart
        End If
        DivParts = UPart / LPart
    Wend
    If WholeNumber = 0 Then
        ConvertDecimalToFraction = CStr(UPart) & "/" & CStr(LPart)
    Else
        If UseWholePartSeperratly Then
            ConvertDecimalToFraction = WholeNumber & " " & CStr(UPart) & "/" & CStr(LPart)
        Else
            ConvertDecimalToFraction = CStr(UPart) & "/" & CStr(LPart)
        End If
    End If
End Function

Καλή συνέχεια!

Τάσος