Το excel αγαπάει τις λέξεις!

Κατασκευή λεξικού όλων των λέξεων ενός κειμένου.

BOOKΤο excel χειρίζεται τις λέξεις το ίδιο καλά με τους αριθμούς· το έχουμε δείξει αρκετές φορές σε αυτό εδώ το ιστολόγιο, το ίδιο και με την παρακάτω μακροεντολή που κατασκευάζει ένα πίνακα όλων των λέξεων ενός κειμένου. Η χρήση της είναι πολύ απλή: Πρώτα, επιλέξτε και αντιγράψτε ένα κείμενο από ένα έγγραφο word ή από ένα φύλλο excel ή ένα .txt κείμενο ή ένα κείμενο που βρήκατε στο διαδίκτυο ή ακόμα ένα .pdf κείμενο. (Δεν υπάρχει πρόβλημα αν μαζί αντιγράψετε χρώματα, μορφοποιήσεις και εικόνες· θα αγνοηθούν). Αμέσως μετά τρέξτε την μακροεντολή και αυτό είναι όλο. Θα προστεθεί στο βιβλίο σας, ένα νέο φύλλο όπου στην στήλη Α θα εμφανιστούν όλες οι διαφορετικές λέξεις (λεκτικοί τύποι) του κειμένου αλφαβητικά ταξινομημένες και στη στήλη Β η συχνότητα εμφάνισης κάθε λέξης. Ανοίξτε, (κλικ στο +) για να δείτε τον κώδικα:

Sub Lexicographer()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim i As Long
Dim sheetname As String
Dim kelli As Range
Dim keimeno As Range
Dim lexeis As Variant
Dim lexi As String
Dim lexiko As Scripting.Dictionary
Set lexiko = New Scripting.Dictionary

'Ανοίγει ένα νέο φύλλο:
Sheets.Add
sheetname = ActiveSheet.Name

'Γίνεται επικόλληση στο φύλλο, ανάλογα με την
'μορφή του κειμένου που έχει αντιγραφεί:
On Error Resume Next
 ActiveSheet.PasteSpecial Format:=3
 ActiveSheet.PasteSpecial noHTMLFormatting:=True
 ActiveSheet.DrawingObjects.Delete
 Call ClearErrors
On Error GoTo 0

Application.CutCopyMode = False
Application.Calculation = xlCalculationManual

Cells.Select
Set keimeno = Selection
Set keimeno = Application.Intersect(ActiveSheet.UsedRange, keimeno)

'Έξοδος αν δεν έχει αντιγραφεί κείμενο:
If VBA.IsEmpty(keimeno) Then _
 MsgBox "Δεν έχεις αντιγράψει κείμενο!", , "Excel Λύσεις": _
 ActiveSheet.Delete: GoTo telos

For Each kelli In keimeno
 lexeis = kelli.Value
 'καλείται η συνάρτηση DeletePunctuation για να αντικαταστήσει
 'τα σημεία στίξεως και αλλά τυχόν σύμβολα του κειμένου με κενό:
 On Error Resume Next
 lexeis = DeletePunctuation(lexeis)
 If Err Then lexeis = ""
 Err.Clear
 On Error GoTo 0
 'Αφαιρούνται τα πλεονάζοντα κενά (Trim),και η Split
 'με delimiter το κενό, δημιουργεί ένα πίνακα λέξεων(lexeis):
 lexeis = VBA.Split(Application.Trim(lexeis), " ")

 'Μία-μία οι λέξεις εισάγονται στο Dictionary (lexiko)
 'σαν κλειδιά με item =1, αν ήδη υπάρχουν απορρίπτονται
 'και η αρίθμηση του item αυξάνει κατά 1
 'Δεν γίνεται διάκριση πεζών - κεφαλαίων γραμμάτων
 lexiko.CompareMode = TextCompare
 For i = LBound(lexeis) To UBound(lexeis)
 lexi = lexeis(i)
 If lexiko.Exists(lexi) Then
 lexiko.Item(lexi) = lexiko.Item(lexi) + 1
 Else
 lexiko.Item(lexi) = 1
 End If
 Next i
Next kelli

Sheets(sheetname).Cells.Select: Selection.Clear

'Έξοδος στο φύλλο:
Range(Cells(1, 1), Cells(lexiko.Count, 1)) = Application.Transpose(lexiko.Keys)
Range(Cells(1, 2), Cells(lexiko.Count, 2)) = Application.Transpose(lexiko.Items)

Set lexiko = Nothing

Range("A:A").EntireColumn.AutoFit
'Αλφαβητική ταξινόμηση:
Columns("A:B").Sort Key1:=Range("A1")
Range("a1").Select

telos:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Private Sub ClearErrors()
'Καλείται αμέσως μετά την επικόλληση στο φύλλο για να
'αντιμετώπιση την (μικρή) πιθανότητα κάποιο κείμενο '
'να έχει εισαχθεί σαν συνάρτηση.
Dim kelia As Range
Dim keli As Range
Set kelia = Nothing
Set kelia = Selection.SpecialCells(xlCellTypeFormulas, 16)
If Not kelia Is Nothing Then
For Each keli In kelia
keli = "'" & keli.Formula
Next
End If
End Sub

Private Function DeletePunctuation(ByVal text As String) As String
Dim Varr As Variant
Dim point As Integer
Varr = VBA.Array(33, 34, 35, 39, 40, 41, 42, 43, 44, 45, 46, 47, 58, 59, _
 60, 61, 62, 63, 91, 92, 93, 95, 96, 123, 124, 125, 126, 160, _
 166, 167, 180, 182, 171, 183, 187, 900, 903, 8127, 8189, 8211, 8212, _
 8216, 8217, 8218, 8220, 8221, 8222, 8226, 8230)
For point = 0 To 48
text = VBA.Replace(text, VBA.ChrW(Varr(point)), " ")
Next
DeletePunctuation = text
End Function

Η μάκρο, ακόμα και για πολύ μεγάλα κείμενα, είναι γρήγορη χάρη στο εργαλείο dictionary της vba με το οποίο δημιουργείται το λεξιλόγιο. Γράψτε ή αντιγράψτε την μακροεντολή σε ένα module ενός νέου κενού βιβλίου. Επί πλέον, για να έχετε πρόσβαση στο dictionary πρέπει να ορίσετε μια αναφορά προς την βιβλιοθήκη Microsoft Scripting Runtime. Για να το κάνετε αυτό, στον Editor της Visual Basic πρώτα επιλέξτε το module της μακροεντολής και στη συνέχεια στο μενού Tools επιλέξτε References. Στο πλαίσιο που θα εμφανιστεί, κινηθείτε προς τα κάτω με τα βέλη, βρείτε την Microsoft Scripting Runtime, επιλέξτε τη και πατήστε OK. (Δέστε την επόμενη εικόνα).

Ορισμός αναφοράς προς την βιβλιοθήκη Microsoft Scripting Runtime

Ορισμός αναφοράς προς την βιβλιοθήκη Microsoft Scripting Runtime

Εναλλακτικά κατεβάστε το lexicographer07.xlsm βιβλίο (για excel 2007, 2010, 2013) ή το βιβλίο lexicographer03.xls βιβλίο (για excel 2002, 2003). Μοναδικός περιορισμός: το αρχικό κείμενο που θα αντιγράψετε δεν πρέπει να περιέχει περισσότερες από 1.048.576 γραμμές (ή 65.536 γραμμές για τα excel 2002, 2003). Αν ξεπεραστούν τα όρια αυτά, οι επί πλέον γραμμές θα αγνοηθούν χωρίς προειδοποίηση. Προσέξτε ο περιορισμός αφορά γραμμές, όχι λέξεις· για το πλήθος των λέξεων του αρχικού κειμένου δεν υπάρχει περιορισμός.  Σε εφαρμογή της μακροεντολής, στο δίκτυο βρήκα το πλήρες μονοτονικό κείμενο της Καινής Διαθήκης και αφού το επεξεργάστηκα διαγράφοντας τον πρόλογο και τους ενδιάμεσους τίτλους, βρήκα ότι το καθαρό κείμενο αποτελείται από 140.481 λέξεις που ομαδοποιούνται σε 18.198 διαφορετικούς λεκτικούς τύπους. Χρόνος που χρειάστηκε η μακροεντολή, στο δικό μου υπολογιστή, 4 sec. Παρόμοια στο δίκτυο βρήκα ολόκληρα τα κείμενα της Ιλιάδας (πολυτονικό) και του Ερωτόκριτου και πήρα αντίστοιχα 111.614 / 21.348 για την Ιλιάδα και 85.418 / 10.454 για τον Ερωτόκριτο.

Τμήμα του λεξικού της Καινής Διαθήκης

Τμήμα του λεξικού της Καινής Διαθήκης

Για να τεστάρετε τις δυνατότητες του κώδικα με πολύ μεγάλα κείμενα, εδώ θα βρείτε ένα κείμενο 840.000 λέξεων (μετάφραση στην αγγλική γλώσσα της Αγίας Γραφής, είναι το αρχείο: “entire KJV Bible, single large file, text, 1.2MB”).  Οι σειρές του είναι λιγότερες από 40.000, άρα μπορείτε να το επεξεργαστείτε από όλες τις εκδόσεις 2002-2013. Ή από εδώ κατεβάστε το αρχείο κειμένου shaks12.txt 5.3M (το συνολικό έργο του Σαίξπηρ) που είναι ένα κείμενο 900.000 λέξεων, αλλά σε 124.000 σειρές, άρα μπορείτε να το επεξεργαστείτε μόνο από τις εκδόσεις 2007-2013.

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

Τα σημεία στίξεως και οι Unicode κωδικοί τους

Τα σημεία στίξεως και οι Unicode κωδικοί τους

Σημείωση: Το .xls βιβλίο lexicographer03.xls τρέχει και σε excel 2000 μόνο για κείμενα που έχετε αντιγράψει από word ή από ένα φύλλο excel, όχι από άλλες πηγές. Αν έχετε ένα .txt κείμενο ανοίξτε το πρώτα στο word και αντιγράψτε από εκεί, πριν καλέσετε την μακροεντολή. Επίσης, στο 2000, μην επιλέγεται πολύ μεγάλα κείμενα.
This entry was posted in excel, Μακροεντολές, VBA, Word and tagged , , , , , , . Bookmark the permalink.

9 Responses to Το excel αγαπάει τις λέξεις!

  1. Ο/Η sakis λέει:

    Συγχαρητήρια για την δουλειά και τον χρόνο που διαθέτεις για να μάθουμε το Excel.
    Μήπως γνωρίζεις γιατί όταν γράφω το γράμμα “τ” το excel το μετατρέπει σε “τα” και τι μπορώ να κάνω.
    Ευχαριστώ.

  2. Ο/Η vioannis λέει:

    Σάκη,
    Το “τ” όπως και “τσ” γίνεται “τα” όπως και άλλες αλλαγές γίνονται αυτόματα, διότι έχεις ενεργοποιημένη την αντικατάσταση κειμένου κατά την πληκτρολόγηση.
    Πας: Επιλογές, Εργαλεία ελέγχου, Επιλογές αυτόματης διόρθωσης, Αυτόματη διόρθωση και διαγράφεις το τσεκ από την επιλογή «Αντικατάσταση κειμένου κατά την πληκτρολόγηση»
    Εναλλακτικά, επειδή αυτή η δυνατότητα γενικά είναι χρήσιμη, τρέξε τον κατάλογο που είναι στην καρτέλα “Αυτόματη διόρθωση” και διάγραψε τις περιπτώσεις (αντικαταστάσεις) που σε ενοχλούν ή προσθέτεις δικές σου αντικαταστάσεις. Παράδειγμα, κάνε προσθήκη της αντικατάστασης των αρχικών του ονόματός σου με το πλήρες όνομα σου. Ή δύο-τριών γραμμάτων της επιλογής σου με τον πλήρη τίτλο της εταιρείας σου. Εγώ πχ έχω κάνει τις παρακάτω προσθήκες: με δύο κόμματα(,,) να παράγεται η άνω τελεία(·), με δύο αγγλικά ερωτηματικά (??) να παράγεται το ελληνικό ερωτηματικό(;) και άλλα.

  3. Ο/Η sakis λέει:

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

  4. Ο/Η odysseasgrey λέει:

    Συγχαρητήρια για το άρθρο και την προσπάθεια. Μια ερώτηση: Για να εφαρμόσω τα παραπάνω στο calc του openoffice τι πρέπει να κάνω;

  5. Ο/Η vioannis λέει:

    Δυστυχώς δεν έχω καθόλου εμπειρία από το open office. Δεν γνωρίζω αν ο vba κώδικας που χρησιμοποιείται εδώ, είναι συμβατός με το open office.

  6. Ο/Η odysseasgrey λέει:

    Ok, θα το δοκιμάσω, αν και δεν ελπίζω.. Ευχαριστώ όπως και νάχει και συγχαρητήρια και πάλι.

  7. Ο/Η Akis λέει:

    Συγχαρητήρια για την δουλειά και τον χρόνο που διαθέτεις…. αντιμετωπιζώ ένα πρόβλημα και θα ήθελα την βοήθεια σου αν γνωρίζεις. σε ένα κελί έχω ένα κείμενο πχ στο κελί Α1 έχω το κείμενο «καλημερα τι κάνεις, η ώρα είναι 2100utc» και θέλω με κάποια συνάρτηση να βρίσκω κάποια λέξη πχ την «κάνεις» να την κάνω cut και να την περνάω σε διαφορετκό κελί και στο κελί Α1 να παραμένει το υπόλοιπο κείμενο….
    Αν έχεις κάποια ιδέα να με βοηθήσεις θα σου είμαι υπόχρεως.

  8. Ο/Η vioannis λέει:

    Άκη, αν στο κελί Α1 είναι η πρόταση “καλημέρα τι κάνεις, η ώρα είναι 21:00” και στο κελί Β1 η λέξη “κάνεις”, τότε στο κελί C1 ο τύπος:

    =SUBSTITUTE(A1;B1&CHAR(32);"")
    

    Θα επιστρέψει: “καλημέρα τι, η ώρα είναι 21:00”
    Δηλαδή, η συνάρτηση φύλλου SUBSTITUTE αντικαθιστά το κείμενο του Β1 συν ένα κενό (CHAR(32)), από το κείμενο του Α1, με το “τίποτα” («»)
    Αν η λέξη που θέλεις να απαλείψεις, εμφανίζεται περισσότερες από μία φορά στο αρχικό κείμενο, τότε η προηγούμενη συνάρτηση θα απαλείψει όλες τις εμφανίσεις της λέξης. Εκτός αν καθορίσεις ποια εμφάνιση θα απαλειφτεί. Η επόμενη συνάρτηση θα απαλείψει την δεύτερη εμφάνιση της λέξης:

    =SUBSTITUTE(A1;B1&CHAR(32);"";2)
    

    Καμία συνάρτηση όμως, ούτε συνάρτηση γραμμένη σε vba, δεν μπορεί να τροποποιήσει το κείμενο του κελιού A1, διότι το Α1 θα είναι αναγκαστικά όρισμα της συνάρτησης. Αυτό μπορεί να το κάνει μια μακροεντολή. Αν σε ενδιαφέρει κάτι τέτοιο επανέρχεσαι με περισσότερες λεπτομέρειες. Παράδειγμα ποιο είναι το κριτήριο που επιλέγεις την λέξη που θα αφαιρεθεί;

  9. Ο/Η Argiris Rouggeris λέει:

    Euxaristw polu gia tis Odhgies sou.

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