Γιατί μόνο η ROMAN;

Ας ξεκινήσουμε με λίγη γκρίνια. (Τι blog θα ήμασταν άλλωστε αν δεν γκρινιάζαμε για όλα τα στραβά γύρω μας ενώ εμείς είμαστε τέλειοι!). Γιατί λοιπόν, μόνο η συνάρτηση ROMAN, κυρία Microsoft, να υπάρχει στο excel;
Η ROMAN μετατρέπει έναν (αραβικό) αριθμό σε λατινικό, με τη μορφή κειμένου.
Παράδειγμα η ROMAN(2011) θα επιστρέψει. MMXI.
Δεν υπάρχει όμως μια συνάρτηση που να δέχεται σαν όρισμα   έναν (αραβικό) αριθμό και να επιστέφει τον αριθμό στην αρχαία Ελληνική γραφή.
Aς πούμε: HELLAS(2011)= ,βια΄
Η συνάρτηση χρήστη που προτείνω η HellenicNumber(n,tonos) κάνει αυτό ακριβώς. Δέχεται σαν όρισμα έναν ακέραιο αριθμό από το 1 έως 9999 και επιστρέφει τον αριθμό στην αρχαία ελληνική γραφή του. Έτσι:
HellenicNumber(568)= φξη´
HellenicNumber(8543)= ,ηφμγ´
Η συνάρτηση αποδίδει και τα σύμβολα στίγμα (6), κόππα (90) και σαμπί (900) αρκεί να δουλεύετε με excel μεγαλύτερο του 2000. Η συνάρτηση δέχεται και ένα προαιρετικό όρισμα  “tonos”. Αν το ορίσετε false δεν θα εμφανίζεται ο άνω τόνος στο τέλος του αριθμού. Ο κάτω εμπρός τόνος για τους αριθμούς 1000 έως 9999 φυσικά θα εμφανίζεται. Αν θέλετε τον ελληνικό αριθμό σε κεφαλαία γράμματα χρησιμοποιήστε την συνάρτηση UPPER. Έτσι η  =UPPER(HellenicNumber(457)) θα σας δώσει ΥΝΖ´ 
Αν νοιώθετε ότι θα σας είναι χρήσιμη η συνάρτηση ή ότι θα διασκεδάσετε μαζί της, αντιγράψτε την σε ένα βιβλίο(ή στο personal.xls ) και καλή διασκέδαση.
Για τη γραφή των αριθμών συμβουλεύτηκα την ΙΣΤΟΡΙΑ ΤΩΝ ΕΛΛΗΝΙΚΩΝ ΜΑΘΗΜΑΤΙΚΩΝ  του Ε. Σ. Σταμάτη (Αθήνα 1976) και ΟΙ ΙΣΤΟΡΙΚΕΣ ΡΙΖΕΣ ΤΩΝ ΣΤΟΙΧΕΙΩΔΩΝ  ΜΑΘΗΜΑΤΙΚΩΝ του  Lucas  Bunt (Αθήνα 1981)
Θα επανέλθω στο θέμα με μια συνάρτηση που προσπαθεί να προσεγγίσει την αρχαιοελληνική γραφή πιο μεγάλων αριθμών.
Function HellenicNumber(ByVal n As Double, Optional tonos As Boolean = True) As String
'by ioannis varlamis 2006
Application.Volatile True
If n < 0 Or n > 9999 Then HellenicNumber = CVErr(xlErrValue): GoTo telos
If n <> Int(n) Then HellenicNumber = CVErr(xlErrValue): GoTo telos
Dim atonos As String
Dim ktonos As String
Dim M As Integer
Dim D As Integer
Dim E As Integer
Dim X As Integer
If n Mod 1000 = 0 Or tonos = False Then atonos = "" Else atonos = ChrW(180)
If n > 999 Then ktonos = ChrW(44) Else ktonos = ""
M = n Mod 10 + 1
D = Int(n / 10) Mod 10 + 11
E = Int(n / 100) Mod 10 + 21
X = Int(n / 1000) Mod 10 + 1
HellenicNumber = ktonos & Choise(X) & Choise(E) & Choise(D) & Choise(M) & atonos
HellenicNumber = Application.WorksheetFunction.Substitute(HellenicNumber, ChrW(32), "")
telos:
End Function
Private Function Choise(Ind As Integer) As String
Choise = ChrW(Choose(Ind, 32, 945, 946, 947, 948, 949, _
987, 950, 951, 952, 32, 953, 954, 955, 956, 957, 958, _
959, 960, 991, 32, 961, 963, 964, 965, 966, 967, 968, 969, 993))
End Function
Αν θέλετε κατεβάστε ένα excel βιβλίο με την συνάρτηση: VbaHellenicNumberFunction
This entry was posted in excel, Συναρτήσεις Χρήστη, VBA and tagged . Bookmark the permalink.