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

[kiroukos]

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

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

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

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

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

[tsgiannis]

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

[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

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

Τάσος

[kiroukos]

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

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

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

[kiroukos]

Καλησπέρα .

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

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

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

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