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

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - [Συναρτήσεις] διπλοεγγραφες με τυχαια σειρα (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/5374-diploeggrafes-me-tyxaia-seira.html)

διπλοεγγραφες με τυχαια σειρα

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

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

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

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

Ευχαριστώ.

Καλησπέρα

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

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

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

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

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

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

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

Καλησπέρα,

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

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

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

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

Κώδικας:

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

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

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

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

Καλησπέρα

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

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