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/1550-aporia-gia-eikoli-eiresi-epanalambanomenon-timon.html)

Απορία για εύκολη εύρεση επαναλαμβανόμενων τιμών

γεια παιδια κ χρονια πολλα .εχω μια απορια .θελω με καποιον τροπο με συναρτηση η αλλη ενεργεια να βρισκω ομοιες τιμες σε πχ 10 γραμμες ποιες τιμες επαναλαμβανονται κ αν γινεται να μη δινω συγκεκριμενη τιμη αλλα αυτοματα το προγραμμα να βρισκει τις ομοιες υπαρχει κ η ευρεση αλλα δεν ειναι ευχρηστη ειδικα οταν δουλευεις με πολλες τιμες επειδη το θεμα ειναι σημαντικο για μενα οποιος μπορει να με διαφωτισει .....μηπως αυτο που ζηταω μπορω να το πετυχω σε αλλο προγραμμα του οφις ? ευχαριστω πολυ

Διπλότυπα

Καλημέρα
Αυτά ισχύουν για επισήμανση και οχι κατάργηση διπλότυπων
Υπάρχουν διάφοροι τρόποι στο Συνημμένο
Ελπίζω να βοηθήσουν
Η Μακροεντολή είναι

Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant
' Set CompareRange equal to the range to which you will
' compare the selection.
Set CompareRange = Range("C1:C5")
' NOTE: If the compare range is located on another workbook
' or worksheet, use the following syntax.
' Set CompareRange = Workbooks("Book2"). _
' Worksheets("Sheet2").Range("C1:C5")
'
' Loop through each cell in the selection and compare it to
' each cell in CompareRange.
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 1) = x
Next y
Next x
End Sub

ΚΑΛΗ ΧΡΟΝΙΑ!!!

ευχαριστω πολυ

Καλησπέρα σε όλη την παρέα

Εχω ένα αρχείο με 1100 εγγραφες. Οι στήλες είναι 29.
Καποιες γραμμες είναι ακριβως ίδιες και θα ΄ήθελα να τις επισημάνω.

Σκεφτόμουν μήπως με κάποια μετατροπή του κώδικα του Σπύρου μπορεί να γίνει αυτό.

Ευχαριστώ

Καλημέρα.
Μάνο, ο καλύτερος τρόπος, για να λύσουμε ένα πρόβλημα,
είναι εξ' αρχής, να γνωρίζουμε, τι θα πρέπει να κάνουμε στο τέλος.
Το να «εντοπίσουμε» τις διπλοεγγραφές, θα έχει και συνέχεια;
Πχ διαγραφή;
Ακόμα,
το να «εντοπίσουμε» τις διπλοεγγραφές, έχει κάποιους ... ας πούμε περιορισμούς.
Ο κώδικας παρακάτω για παράδειγμα, χρησιμοποιεί για τον «εντοπισμό», χρώματα.
Τι γίνεται όμως, αν ο χρήστης, έχει ήδη χρώματα στο φύλλο του;
Το ίδιο, μπορεί να συμβεί, αν για παράδειγμα, αλλάξει χρώμα η γραμματοσειρά.

Πρόταση 1
Μετά την τελευταία στήλη, (στην 30 η) βάλε Concatenate και εντόπισε τα διπλότυπα,
με Conditional Formatting
Πρόταση 2
Έχοντας κάνει την πρώτη ενέργεια, μπορείς να:
Μετά την νέα τελευταία στήλη, (στην 31 η) βάλε CountIf και «μέτρα»,
ποια κελιά της 30 ης, είναι >1.
Με φίλτρο, ως προς >1, μπορείς να έχεις «πιάτο», μόνο τις διπλοεγγραφές.
Αποφασίζεις τότε, τι θα τις κάνεις...
Πρόταση 3
Ο παρακάτω κώδικας, για να μπορέσει να τρέξει, «θέλει» να ενεργοποιηθεί από το Tools >> References
το Microsoft Scripting Runtime.
Μερικές πληροφορίες:
Χρησιμοποιεί, διπλό χρωματισμό για:
Πρώτη εγγραφή (ΚΙΤΡΙΝΟ) - επόμενες διπλότυπες εγγραφές (ΠΡΑΣΙΝΟ)
*Τα χρώματα, μπορεί να αλλάξουν αν θέλει ο χρήστης.
Δεν υπολογίζει ως διπλότυπα, κενές γραμμές.
Σημείωση:
Το μικρό κωδικάκι επαναφέρει τα χρώματα σε ... «τίποτα».

Κώδικας:

Option Explicit
 'Να ενεργοποιηθεί το Microsoft Scripting Runtime

'Tools >> References

Sub HighDupes()

    Dim iWSt As Worksheet

    Dim iRow As Range

    Dim iCol As Range

    Dim NewString As String

    Dim iDictionary As Dictionary

    Set iDictionary = New Dictionary

    Set iWSt = Sh1

    Application.ScreenUpdating = False

    For Each iRow In iWSt.UsedRange.Rows

        'Αν οι γραμμές είναι κενές (Blank Rows) τότε skip

        If Application.CountA(iWSt.Rows(iRow.Row)) > 0 Then

            NewString = "Ο_ΤΙΤΛΟΣ_ΤΟΥ_ΦΥΛΛΟΥ" 'ΧωρίςΚενά - εννοείται και στο φύλλο ...

            For Each iCol In iWSt.UsedRange.Columns

                NewString = NewString & "||" & iWSt.Cells(iRow.Row, iCol.Column)

            Next

            If iDictionary.exists(NewString) Then

                'Διπλός χρωματισμός: Πρώτης εγγραφής - επόμενων εγγραφών

                iWSt.Rows(iRow.Row).Interior.Color = vbYellow 'ΚΙΤΡΙΝΟ

                iWSt.Rows(iDictionary(NewString)).Interior.Color = vbGreen ' ΠΡΑΣΙΝΟ

            Else

                iDictionary.Add NewString, iRow.Row

            End If

        End If

    Next

    Application.ScreenUpdating = True

    Set iDictionary = Nothing

    Set iWSt = Nothing

End Sub
 
 'Επαναφορά χρωμάτων

Sub ColorReset()

    Application.ScreenUpdating = False

    ActiveSheet.Cells.Interior.Color = xlNone

End Sub

Καλημέρα

Μανώλη, δες μια πρόταση στο συνημμένο.

Οι γραμμές των δεδομένων χωρίζονται σε δύο ομάδες (0) και (1).

Η ομάδα (0) περιλαμβάνει όλες τις διαφορετικές γραμμές.

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

Η ομάδα (1) περιλαμβάνει τις υπόλοιπες γραμμές.

Δηλαδή κάθε γραμμή στην ομάδα αυτή εκπροσωπείται στην ομάδα (0) και συνεπώς θα μπορούσε να διαγραφεί.

Περισσότερα για την επισήμανση των ομάδων και τη διαγραφή των γραμμών (περιττών) της ομάδας (1), στο συνημμένο.

Φιλικά/Γιώργος

Καλησπέρα σε όλη την παρέα

Πριν απο όλα θα ήθελα να ζητήσω συγγνώμη που δεν ανέβασα κάποιο παράδειγμα.

Σπύρο και Γιώργο σας ευχαριστώ πολύ για τις λύσεις που μου προτείνατε.

Επειδή με με πίεζε ο χρόνος δεν προλαβαινα να τις κοιτάξω όλες,

Επειδή μου φάνηκε πιο ευκολη , χρησιμοποίησα την λύση με την Concatenate και πήρα το αποτέλεσμα που ήθελα.

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

Με εκτίμηση