Σε αυτό το άρθρο, θα δημιουργήσουμε ένα Πλαίσιο λίστας σε μορφή χρήστη και θα το φορτώσουμε με τιμές αφού αφαιρέσουμε διπλές τιμές.
Τα ακατέργαστα δεδομένα που θα εισαγάγουμε στο πλαίσιο λίστας, αποτελούνται από ονόματα. Αυτά τα ακατέργαστα δεδομένα περιέχουν διττότητα σε καθορισμένα ονόματα.
Σε αυτό το παράδειγμα, έχουμε δημιουργήσει μια μορφή χρήστη που αποτελείται από Λίστα. Αυτό το πλαίσιο λίστας θα εμφανίζει μοναδικά ονόματα από τα δείγματα δεδομένων. Για να ενεργοποιήσετε τη μορφή χρήστη, κάντε κλικ στο κουμπί υποβολής.
Αυτή η μορφή χρήστη θα επιστρέψει το όνομα που έχει επιλέξει ο χρήστης ως έξοδος σε ένα πλαίσιο μηνυμάτων.
Λογική εξήγηση
Πριν προσθέσουμε ονόματα στο πλαίσιο λίστας, χρησιμοποιήσαμε το αντικείμενο συλλογής για την κατάργηση διπλών ονομάτων.
Έχουμε εκτελέσει τα ακόλουθα βήματα για την κατάργηση διπλών καταχωρήσεων:-
-
Προστέθηκαν ονόματα από το καθορισμένο εύρος στο φύλλο Excel στο αντικείμενο συλλογής. Στο αντικείμενο συλλογής, δεν μπορούμε να εισαγάγουμε διπλές τιμές. Έτσι, το αντικείμενο συλλογής ρίχνει σφάλμα όταν συναντάμε διπλές τιμές. Για να χειριστούμε τα σφάλματα, έχουμε χρησιμοποιήσει τη δήλωση σφάλματος "On Error Resume Next".
-
Αφού προετοιμάσετε τη συλλογή, προσθέστε όλα τα στοιχεία από τη συλλογή στη συστοιχία.
-
Στη συνέχεια, εισαγάγετε όλα τα στοιχεία πίνακα στο πλαίσιο λίστας.
Ακολουθήστε παρακάτω για τον κωδικό
Option Explicit Sub running () UserForm1.Show End Sub 'Προσθέστε τον παρακάτω κώδικα στη μορφή χρήστη Option Explicit Private Sub CommandButton1_Click () Dim var1 As String Dim i As Integer' Looping through all the values available in the list list 'Εκχώρηση της επιλεγμένης τιμής σε μεταβλητή var1 Για i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected (i) Στη συνέχεια var1 = ListBox1.List (i) Exit For End If Next 'Unload the userform. Unload Me 'Εμφάνιση της επιλεγμένης τιμής MsgBox "Έχετε επιλέξει το ακόλουθο όνομα στο πλαίσιο λίστας:" & var1 End Sub Private Sub UserForm_Initialize () Dim MyUniqueList As Variant, i As Long' Calling UniqueItemList function 'Αντιστοίχιση του εύρους ως παραμέτρου εισόδου MyUniqueList = UniqueItemList (Range ("A12: A100"), True) With Me.ListBox1 "Εκκαθάριση του περιεχομένου του πλαισίου λίστας. Διαγραφή" Προσθήκη τιμών στο πλαίσιο λίστας για i = 1 στο UBound (MyUniqueList). Προσθήκη αντικειμένου MyUniqueList (i) Επόμενο i " Επιλογή του πρώτου στοιχείου .ListIndex = 0 Τέλος με Τέλος Sub Private Function UniqueItemList (InputRange As Range, _ HorizontalList As Boolean) As Variant Dim cl As Range, cUnique As New Collection, i As Long 'Declaring a dynamic array Dim uList () As Παραλλαγή "Δήλωση αυτής της συνάρτησης ως πτητική" Η συνάρτηση Μέσων θα υπολογίζεται εκ νέου κάθε φορά που συμβαίνει υπολογισμός σε οποιαδήποτε εφαρμογή κελιού. Πτητικό σφάλμα Συνέχιση Επόμενο "Προσθήκη στοιχείων στη συλλογή" Μόνο μοναδικό στοιχείο θα εισαχθεί "Εισαγωγή διπλού στοιχείου θα μέσω σφάλματος για κάθε cl In InputRange If cl.Value "" Στη συνέχεια "Προσθήκη τιμών στη συλλογή cUnique.Προσθήκη cl.Value, CStr (cl.Value) Τέλος Αν Επόμενο cl 'Initializing value return by the function UniqueItemList =" "If cUnique.Count> 0 then 'Αλλαγή μεγέθους πίνακα ReDim uList (1 To cUnique.Count)' Εισαγωγή τιμών από συλλογή σε πίνακα Για i = 1 To cUnique.Count uList (i) = cUnique (i) Next i UniqueItemList = uList 'Έλεγχος της τιμής του HorizontalList' Εάν η τιμή είναι αληθής, τότε μεταφέρετε την τιμή του UniqueItemList If Not HorizontalList Στη συνέχεια UniqueItemList = _ Application.WorksheetFunction.Transpose (UniqueItemList) Τέλος Αν τερματίσει εάν είναι ενεργό Σφάλμα GoTo 0 End Function
Αν σας άρεσε αυτό το blog, μοιραστείτε το με τους φίλους σας στο Facebook. Επίσης, μπορείτε να μας ακολουθήσετε στο Twitter και το Facebook.
Θα θέλαμε πολύ να σας ακούσουμε, ενημερώστε μας πώς μπορούμε να βελτιώσουμε το έργο μας και να το κάνουμε καλύτερο για εσάς. Γράψτε μας στον ιστότοπο email