Forum - ΜΕΤΑΤΡΟΠΗ ΔΕΚΑΔΙΚΩΝ ΣΕ ΚΛΑΣΜΑΤΑ

Forum (https://www.ms-office.gr/forum/)

- Access - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/)

- - ΜΕΤΑΤΡΟΠΗ ΔΕΚΑΔΙΚΩΝ ΣΕ ΚΛΑΣΜΑΤΑ (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/5731-metatroph-dekadikon-se-klasmata.html)

ΜΕΤΑΤΡΟΠΗ ΔΕΚΑΔΙΚΩΝ ΣΕ ΚΛΑΣΜΑΤΑ

Καλημέρα στην υπέροχη ομάδα.

Προσπάθησα να βρω ανάλογο θέμα αλλά δεν το κατάφερα.

Πως μετατρέπεται κάποιος δεκαδικός αριθμός σε κλάσμα ;

Στο ecxel υπάρχει τύπος ο (?/?) .

Πως μπορούμε να το κάνουμε σε πεδίο σε φόρμα ή σε έκθεση ;

Δες λίγο αυτό το Post : https://www.tek-tips.com/viewthread.cfm?qid=206890

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

Η συνάρτηση 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

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

Τάσος

Να ζητήσω πρώτα από όλα μια συγνώμη για την μεγάλη καθυστέρηση απάντησης στα σχετικά των αγαπημένων συνομιλητών .
Δεν είχα δυνατότητα επικοινωνίας λόγω προσωπικών προβλημάτων.
Να ευχηθώ Καλή Χρονιά με ΥΓΕΙΑ και να ευχαριστήσω για την βοήθεια τον Γιάννη και τον Τάσο.

Η αλήθεια είναι πως τώρα θα ασχοληθώ , εαν χρειαστώ βοήθεια θα ενοχλήσω και πάλι.

Ευχαριστώ και πάλι.

Καλησπέρα .

Πως μπορώ να εφαρμόσω την συνάρτηση σε κελί έκθεσης ώστε να λειτουργήσει ο κώδικας ;

Δεν ξέρω καν πως να ξεκινήσω ;

Υπάρχει η δυνατότητα να ανεβεί σε ένα παράδειγμα .

Ευχαριστώ πολύ .