Forum

Αναζήτηση στο ms-office.gr

Πάμε!
ms-office.gr > Forum > Microsoft Excel > Excel - Ερωτήσεις / Απαντήσεις > [VBA] Κατάργηση διπλοτύπων

Excel - Ερωτήσεις / Απαντήσεις Ότι έχει σχέση με συναρτήσεις, μορφοποίηση, εκτυπώσεις γραφήματα κτλ.

Απάντηση στο θέμα

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 03-12-17, 22:21
Όνομα: Μπάμπης
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 11-04-2017
Μηνύματα: 13
Προεπιλογή Κατάργηση διπλοτύπων

Αγαπητοί φίλοι του Forum, επανέρχομαι στη βοήθεια σας για συμπλήρωση (γραμμής ;) κώδικα όπου στη στήλη (stili1) του επισυναπτόμενου αρχείου θα αφαιρούνται οι διπλότυπες εγγραφές.
Προσπάθησα να περάσω τη γραμμή που φαίνεται με κίτρινο στη φωτό αλλά βγάζει error.
Δεν θέλω να γίνεται με μακροεντολή, αλλά αν μπορούσε να γίνεται αυτόματα με την εκτέλεση της υπάρχουσας ρουτίνας.
Σας ευχαριστώ.
Συνημμένα Thumbnails
Κατάργηση διπλοτύπων-screenshot_1.png  
Συνημμένα Αρχεία
Τύπος Αρχείου: xlsm Test-dk1.xlsm (17,8 KB, 8 εμφανίσεις)
Απάντηση με παράθεση
  #2  
Παλιά 04-12-17, 18:55
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 2.584
Προεπιλογή

Καλησπέρα

Μπάμπη, δεν καταλαβαίνω ούτε τι θέλεις, ούτε τον κώδικα.

Πάντως για να μη χτυπάει ο κώδικας αντικατέστησε τη γραμμή με την:

Φύλλο2.Range("Πίνακας1[#All]").RemoveDuplicates
Απάντηση με παράθεση
  #3  
Παλιά 05-12-17, 19:00
Όνομα: Μπάμπης
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 11-04-2017
Μηνύματα: 13
Προεπιλογή remove duplicates

Ευχαριστώ για την άμεση απάντηση φίλε Kapatang , η πρόταση σου δούλεψε εν μέρη γιατί πρέπει να κλικάρεις στο Φύλλο2 (οπουδήποτε) για να εφαρμοστεί το "RemoveDuplicates" δεν γίνεται δηλαδή αυτόματα. Επισυνάπτω πάλι το αρχείο
Συνημμένα Αρχεία
Τύπος Αρχείου: xlsm Test-dk1.xlsm (24,0 KB, 8 εμφανίσεις)
Απάντηση με παράθεση
  #4  
Παλιά 05-12-17, 20:48
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 2.584
Προεπιλογή

Καλησπέρα

Φίλε Μπάμπη μάλλον έχεις μπερδευτεί.

Στο φύλλο «Φύλλο2» έχεις μία λίστα τιμών και θέλεις:

1) Στο φύλλο1 και στη στήλη C να επιλέγεις μία τιμή της λίστας.

2) Η επιλεγείσα τιμή να προστίθεται στη λίστα του φίλλου2 (από την οποία έχει επιλεχθεί) και

3) Αυτόματα να απομακρύνονται από τη λίστα του φύλλο2 οι διπλότυπες τιμές.

Όπως καταλαβαίνεις θα δημιουργηθεί ένας φαύλος κύκλος.

Μόλις η επιλεγείσα τιμή προστεθεί στη λίστα του φύλλο2, θα διαγραφεί, αφού θα δημιουργήσει διπλότυπες τιμές.

Έχω τη γνώμη ότι θα πρέπει να ξανασκεφτείς το πρόβλημά σου και να το περιγράψεις με σαφήνεια.
Απάντηση με παράθεση
  #5  
Παλιά 05-12-17, 21:53
Όνομα: Μπάμπης
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 11-04-2017
Μηνύματα: 13
Προεπιλογή

Μάλλον δεν έγινα σαφής. Το αρχείο δουλεύει κανονικά όπως θέλω. Το μόνο πρόβλημα είναι να καταργούνται οι διπλότυπες εγγραφές (αν υπάρχουν) αυτόματα από τη λίστα του Φύλλου2, χωρίς να χρειάζεται να κλικάρω οπουδήποτε στο Φύλλο2 ... (ημιαυτόματα, δηλαδή με κλικ οπουδήποτε, γίνεται)

Τελευταία επεξεργασία από το χρήστη Mpampis9050 : 05-12-17 στις 23:22.
Απάντηση με παράθεση
  #6  
Παλιά 06-12-17, 08:00
Το avatar του χρήστη Spirosgr
Συντονιστής
Όνομα: Σπύρος Τσιλιγιάννης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010, Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 22-11-2011
Περιοχή: Αθήνα
Μηνύματα: 1.910
Προεπιλογή

Το αρχείο, δεν δουλεύει σωστά.

Στο φύλλο2, δεν χρειάζεται καμία εντολή και πρέπει να διαγραφεί.
Στο φύλλο1, έχεις αντιγράψει κομμάτια κώδικα, που δεν είναι σωστά.

Τι θα πρέπει να κάνεις.
Στο φύλλο1:
Κώδικας:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Rows.Count > 1 Then Exit Sub
    If Target.Columns.Count > 1 Then Exit Sub
    If Target.Column <> 3 Then Exit Sub
    If Target.Value = vbNullString Then Exit Sub

    Dim Lrow As Long
    Lrow = Φύλλο2.ListObjects("Πίνακας1").ListRows.Count + 1
    
    Φύλλο2.Cells(Lrow + 1, 1).Value = Target.Value
    Φύλλο2.Range("Πίνακας1[#All]").RemoveDuplicates Columns:=1, Header:=xlYes
'    iSort
End Sub
Αν θέλουμε στο φύλλο2, οι τιμές, να είναι και αλφαβητικά ταξινομημένες, τότε
σε μια module:
Κώδικας:
Sub iSort()
    Φύλλο2.ListObjects("Πίνακας1").Sort.SortFields. _
        Clear
    Φύλλο2.ListObjects("Πίνακας1").Sort.SortFields. _
        Add Key:=Range("Πίνακας1[[#All],[stili1]]"), SortOn:=xlSortOnValues, Order _
        :=xlAscending, DataOption:=xlSortNormal
    With Φύλλο2.ListObjects("Πίνακας1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
και ενεργοποιούμε την προτελευταία γραμμή (πράσινο)

Στην Επικύρωση (validation)...βλέπε εικόνες 1,2

Σημείωση:
Αν κανείς ξεκινήσει από την αρχή την διαδικασία,
δηλαδή στο φύλλο2, έχει έναν «παρθένο» πίνακα με μια κενή γραμμή, τότε
δεν θα υπάρχει μετά την πρώτη καταχώρηση, η κενή γραμμή-κελί στον πίνακα
που εσφαλμένα υπήρχε μέχρι τώρα.
Συνημμένα Thumbnails
Κατάργηση διπλοτύπων-screenshot_1.jpg   Κατάργηση διπλοτύπων-screenshot_2.jpg  
__________________
Spirosgr
spirostsiligiannis@gmail.com
Απάντηση με παράθεση
  #7  
Παλιά 06-12-17, 19:53
Όνομα: Μπάμπης
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 11-04-2017
Μηνύματα: 13
Προεπιλογή

Μετά και από τις προσθήκες κώδικα από τον Spirosgr το αρχείο δουλεύει τέλεια όπως ήθελα, δηλαδή όχι μόνο αντιγραφή και ενημέρωση κελιών στήλης από ένα Φύλλο στο άλλο, αλλά και κατάργηση διπλοτύπων και φυσικά ταξινόμηση.
Θερμές ευχαριστίες στους κορυφαίους Kapetang και Spirosgr για την άμεση ανταπόκριση και καθοδήγηση τους.
Απάντηση με παράθεση
  #8  
Παλιά 06-12-17, 19:55
Το avatar του χρήστη Spirosgr
Συντονιστής
Όνομα: Σπύρος Τσιλιγιάννης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010, Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 22-11-2011
Περιοχή: Αθήνα
Μηνύματα: 1.910
Προεπιλογή

Να 'σαι καλά.
__________________
Spirosgr
spirostsiligiannis@gmail.com
Απάντηση με παράθεση
Απάντηση στο θέμα

Εργαλεία Θεμάτων
Τρόποι εμφάνισης

Δικαιώματα - Επιλογές
Δε μπορείτε να δημοσιεύσετε νέα μηνύματα
Δε μπορείτε να δημοσιεύσετε απαντήσεις
Δεν μπορείτε να επισυνάψετε αρχεία
Δεν μπορείτε να επεξεργαστείτε τα μηνύματα σας

Ο κώδικας ΒΒ είναι σε λειτουργία
Τα Smilies είναι σε λειτουργία
Ο κώδικας [IMG] είναι σε λειτουργία
Ο κώδικας HTML είναι εκτός λειτουργίας
Trackbacks are εκτός λειτουργίας
Pingbacks are εκτός λειτουργίας
Refbacks are εκτός λειτουργίας


Παρόμοια Θέματα

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
[Συναρτήσεις] αυτόματη κατάργηση διπλότυπων mantarinia Excel - Ερωτήσεις / Απαντήσεις 8 02-10-17 15:16
[ Εκθέσεις ] Κατάργηση κενού διαστήματος mgeorge Access - Ερωτήσεις / Απαντήσεις 6 17-02-15 19:43
Κατάργηση φίλτρου σε υποφόρμα parara Access - Ερωτήσεις / Απαντήσεις 0 26-09-13 13:21
Κατάργηση διπλοεγγραφών με κριτήριο georgeserafeim Excel - Ερωτήσεις / Απαντήσεις 2 02-06-10 14:11
Dublicates Remover - Αφαίρεση διπλότυπων εγγραφών στην Access Ms-Office-Development Team Access samples - Χρήσιμα αρχεία & παραδείγματα 0 11-04-10 15:20


Η ώρα είναι 07:54.