Εμφάνιση ενός μόνο μηνύματος
  #4  
Παλιά 29-10-19, 22:20
kapetang Ο χρήστης kapetang δεν είναι συνδεδεμένος
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 3.674
Προεπιλογή

Ελπίζω να βοηθήσουν τα σχόλια που πρόσθεσα στον κώδικα.

Κώδικας:
Option Explicit

Public Function SortWords(rng As Range) As String
    Dim x() As String, i As Long, j As Long
    Dim k As Long, rep As Boolean, c As Range
    Dim ua As Variant, ub As Variant, wd As String

    'Τα γράμματα στο array ua θα αντικατασταθούν από τα αντίστοιχα του ub
    ua = Array("Ά", "Έ", "Ή", "Ί", "Ϊ", "Ό", "ς", "Ύ", "Ϋ", "Ώ")
    ub = Array("Α", "Ε", "Η", "Ι", "Ι", "Ο", "Σ", "Υ", "Υ", "Ω")
    
    'Το πλήθος των κελιών του ορίσματος rng και δήλωση του array x
    k = rng.Count
    ReDim x(1 To k) As String

    For Each c In rng
        i = i + 1
        x(i) = UCase(c) 'Η τιμή του κελιού c σε κεφαλαία αποδίδεται στο x(i)
        
        'Στις τιμές x(i) αντικαθίστανται τα τονισμένα κλπ γράμματα
        For j = 0 To UBound(ua)
            x(i) = Replace(x(i), ua(j), ub(j))
        Next
    Next
    
    rep = True

    'Οι λέξεις, τα στοιχεία x(i), ταξινομούνται
    'με τη μέθοδο φυσαλlίδας (bubble)
    Do While rep
        rep = False
        For i = 1 To k - 1
            If x(i) > x(i + 1) Then
                wd = x(i)
                x(i) = x(i + 1)
                x(i + 1) = wd
                rep = True
            End If
        Next
    Loop

    'Συνενώνονται τα στοιχεία του array x() και επιστρέφονται
    SortWords = Join(x, "|")

End Function
Απάντηση με παράθεση