[Συναρτήσεις] διπλοεγγραφες με τυχαια σειρα

[pierta]

Καλημέρα σας,

Θα ήθελα τη βοήθειά σας.

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

Υπάρχει συνημμένος ένας πίνακας όπου φαίνεται το σημείο της ίδιας εγγραφής.

Ευχαριστώ.

[kapetang]

Καλησπέρα

Οι εγγραφές (γραμμές του πίνακα) που έχουν ίδιες λέξεις (ανεξάρτητα από τη σειρά τους) θεωρούνται «ίσες».

Μια λύση για να βρούμε τις «ίσες» είναι να ταξινομήσουμε τις λέξεις της εγγραφής και στη συνέχεια να τις ενώσουμε σε μία συμβολοσειρά (string).

Μετά την ταξινόμηση και τη συνένωση όλες οι «ίσες» εγγραφές θα μας δώσουν την ίδια συμβολοσειρά.

Συνεπώς αντί να εργαστούμε με τις αρχικές εγγραφές (γραμμές του πίνακα) εργαζόμαστε με τις αντίστοιχες συμβολοσειρές.

Για την ταξινόμηση των λέξεων και τη συνένωση δημιούργησα, με κώδικα, τη συνάρτηση SortWords.

Η ίδια συνάρτηση κάνει και κάποιες αλλαγές ώστε να μπορούμε να έχουμε στον πίνακα και λέξεις με πεζά τόνους και διαλυτικά..

Δες το συνημμένο.

[pierta]

Καλησπέρα,

Σε ευχαριστώ πάρα πολύ για την βοήθεια και τον χρόνο που αφιερώνεις.

Να είσαι καλά.

Αν μπορείς και έχεις την διάθεση να μου εξηγήσεις πως δουλεύει η μακροεντολή θα ήταν υπέροχο.
Ασχολούμαι με μαρκοεντολές αλλά όχι κάτι ιδιαίτερο.
Ευχαριστώ και πάλι.

[kapetang]

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

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

[pierta]

Σε ευχαριστώ πολύ και πάλι. Για τον χρόνο που διαθέτεις αλλά και για την βοήθεια.
Να είσαι καλά.

[kapetang]

Καλή συνέχεια και να είσαι καλά.

[christ]

Καλησπέρα φίλοι μου, Μια ερώτηση, αυτό θα μπορούσε να γίνει με χρήση κάποιας συνάρτησης όπως για παράδειγμα στο βιβλίο που επισυνάπτω όπου θέλω στο πίνακα 2 να έχω μόνο τα ονόματα από μια φορά

[kapetang]

Καλησπέρα

Χρήστο, δες μια πρόταση στο συνημμένο.

[christ]

Πάρα πολύ καλή και εύκολη λύση Γιώργο.
Σε ευχαριστώ πολύ για άλλη μια φορά. Καλό βράδυ.