Κλάσματα ξανά. Μια πολύ ειδική μορφοποίηση κλασμάτων.

abacusΣτο σημείωμα του ιστολογίου “Κλάσματα στο excel” συζητήσαμε την τεχνική με την οποία γράφονται κλάσματα στα κελιά του excel, αλλά και την μορφοποίηση που πρέπει να έχουν τα κελιά ώστε τα κλάσματα να εμφανίζονται στη μορφή που εισάγονται. Το excel είναι πολύ επίμονο στο θέμα των κλασμάτων. Αν δεν φροντίσετε την μορφοποίηση, αμέσως τα απλοποιεί και τα μετατρέπει σε ανάγωγα χωρίς καμία προειδοποίηση. Αν γράψετε 8/10 θα δείτε να γίνετε 4/5 και το καταχρηστικό κλάσμα 17/4 θα μετατραπεί στο μικτό 4 ¼. Μπορείτε να κρατήσετε τη αρχική μορφή του κλάσματος, μόνο αν φροντίσετε την μορφοποίηση του κελιού, με τον τρόπο που περιγράφεται στο παραπάνω σημείωμα.
Υπάρχουν όμως περιπτώσεις κλασμάτων που δεν καλύπτονται από τις παραπάνω μορφοποιήσεις . Αν έχετε λόγους να εμφανίζεται στο φύλλο ένα κλάσμα όπως το 100/100000 και να μην είναι κείμενο αλλά αριθμός, και επιχειρήσετε να δώσετε στο κελί του μορφοποίηση:

???/100000

το excel δεν θα την επιτρέψει. Για την περίπτωση αυτή και για κάθε άλλη περίπτωση που δεν καλύπτεται από τις μορφοποιήσεις που περιγράφονται στο προηγούμενο σημείωμα υπάρχει λύση. Στο κελί που θα υποδεχτεί το παραπάνω κλάσμα, εφαρμόστε την παρακάτω μορφοποίηση:

"100/100000"

Τώρα στο κελί μπορείτε άφοβα να γράψετε το κλάσμα 100/100000, το excel δεν θα το απλοποιήσει και θα το δεχτεί σαν αριθμό, κοιτάξτε στην γραμμή των τύπων, θα δείτε: 0,001.
Για κάθε δύσκολη περίπτωση χρησιμοποιείστε σαν μορφοποίηση, το ίδιο το κλάσμα που θέλετε να γράψετε, κλεισμένο μέσα σε εισαγωγικά. Σημειώστε ότι τα εισαγωγικά είναι απολύτως απαραίτητα, αν τα παραλείψετε, το excel θα δεχτεί την μορφοποίηση, αλλά δεν θα την αποθηκεύσει. Όταν ανοίξετε ξανά το βιβλίο, η μορφοποίηση θα έχει διαγραφεί.
Άλλο παράδειγμα. Για να γράψετε τον μεικτό αριθμό 12 500/50000, δώστε στο κελί του την μορφοποίηση :

"12 500/50000"

Μην ξεχάσετε τα εισαγωγικά!
Με τον τρόπο αυτό μπορείτε να εισάγετε κλάσματα που έχουν έως 15 ψηφία σε αριθμητή και παρονομαστή!
Αν έχετε να γράψετε πολλά τέτοια κλάσματα, είναι φυσικά χρονοβόρο να εισάγατε χωριστά για το καθένα την μορφοποίησή του. Για την περίπτωση αυτή σας ετοίμασα μια μακροεντολή που θα κάνει τη δουλειά για σας. Πρώτα γράψτε τα κλάσματα στα κελιά που θέλετε σαν κείμενο. Μετά επιλέξτε τα, και τρέξτε την μακροεντολή. Ότι βρει η μάκρο στην περιοχή που επιλέξατε, που να μοιάζει σε κλάσμα θα το μετατρέψει σε αριθμό χωρίς να του αλλάξει μορφή. Η μάκρο φροντίζει και επιλέγει για το κάθε κλάσμα την κατάλληλη μορφοποίηση, κάνοντας οικονομία στην ποικιλία των μορφοποιήσεων, γιατί ,ναι μεν, η υποστήριξη του excel λέει ότι κάθε βιβλίο μπορεί να έχει έως 64000 διαφορετικές μορφοποιήσεις, αλλά στην πράξη, βιβλία με μερικές χιλιάδες μόνο μορφοποιήσεις είναι ήδη πολύ βαριά. Να θυμίσω ότι στις διαφορετικές μορφοποιήσεις το excel εκτός από τις μορφοποιήσεις αριθμών προσμετρά τα χρώματα, τα μεγέθη κειμένου, τα είδη γραμματοσειρών, τα περιγράμματα, τα μοτίβα, τις στοιχίσεις κλπ.
Ανοίξτε το πλαίσιο να δείτε και να αντιγράψετε τον κώδικα:

Sub ConvertTextToFraction()
Dim keli As Range
Dim kelia As Range
Dim txt As String
Dim LD As Integer

Set kelia = Selection
On Error Resume Next

For Each keli In kelia
txt = Application.WorksheetFunction.Trim(keli.Text)
txt = Replace(txt, " /", "/")
txt = Replace(txt, "/ ", "/")
LD = Len(CStr(Denominator(txt)))

With keli
Select Case LD
    Case 1 To 4
    Select Case True
        Case WholeNumber(txt) = 0
        .NumberFormat = ChrW(63) & ChrW(47) & Denominator(txt)
        Case WholeNumber(txt) <> 0 And Numerator(txt) < Denominator(txt)
        .NumberFormat = ChrW(35) & ChrW(32) & ChrW(63) & ChrW(47) & Denominator(txt)
        Case WholeNumber(txt) <> 0 And Numerator(txt) >= Denominator(txt)
        .NumberFormat = ChrW(34) & WholeNumber(txt) & ChrW(32) & Numerator(txt) & ChrW(47) & Denominator(txt) & ChrW(34)
    End Select
Case 5 To 15
    Select Case True
        Case WholeNumber(txt) = 0
        .NumberFormat = ChrW(34) & Numerator(txt) & ChrW(47) & Denominator(txt) & ChrW(34)
        Case WholeNumber(txt) <> 0
        .NumberFormat = ChrW(34) & WholeNumber(txt) & ChrW(32) & Numerator(txt) & ChrW(47) & Denominator(txt) & ChrW(34)
    End Select
 Case Else

End Select

.Formula = WholeNumber(txt) + Numerator(txt) / Denominator(txt)
End With
Next
On Error GoTo 0
End Sub
'
'
'
Private Function Denominator(ByVal fraction As String) As Double
Denominator = Split(fraction, "/")(1)
End Function
'
'
'
Private Function Numerator(ByVal fraction As String) As Double
If InStr(1, fraction, " ") = 0 Then
    Numerator = Split(fraction, "/")(0)
Else
    Numerator = Split(Split(fraction, " ")(1), "/")(0)
End If
End Function
'
'
'
Private Function WholeNumber(ByVal fraction As String) As Double
If InStr(1, fraction, " ") = 0 Then
    WholeNumber = 0
Else
    WholeNumber = Split(fraction, " ")(0)
End If
End Function

This entry was posted in excel, Μακροεντολές, VBA and tagged , , , , . Bookmark the permalink.

2 Responses to Κλάσματα ξανά. Μια πολύ ειδική μορφοποίηση κλασμάτων.

  1. Ο/Η .: admin :. λέει:

    Πολύ ενδιαφέρον . Ευχαριστώ πολύ.

  2. Ο/Η vioannis λέει:

    Σημειώστε ότι η παραπάνω μέθοδος δεν είναι πιστοποιημένη. Την προσέγγισα στην προσπάθειά μου να λύσω τα ειδικά προβλήματα ενός αρχείου. Για πρώτη φορά την παρουσιάζω εδώ, αφού προηγουμένως την δοκίμασα σε διάφορες εκδόσεις του excel με επιτυχία. Αν εσείς συναντήσετε κάποιο πρόβλημα κατά την εφαρμογή της, μπείτε στον κόπο να με ενημερώσετε.

Τα σχόλια είναι απενεργοποιημένα.