Bu yazımızda userform içerisinde bir List Box oluşturacağız ve mükerrer değerleri çıkardıktan sonra değerlerle yükleyeceğiz.
Liste Kutusuna ekleyeceğimiz ham veriler isimlerden oluşmaktadır. Bu ham veriler, tanımlanmış adlarda yineleme içerir.
Bu örnekte List Box'tan oluşan bir userform oluşturduk. Bu Liste Kutusu, örnek verilerden benzersiz adlar gösterecektir. Kullanıcı formunu etkinleştirmek için gönder düğmesine tıklayın.
Bu kullanıcı formu, kullanıcı tarafından seçilen adı bir mesaj kutusunda çıktı olarak döndürür.
Mantıksal açıklama
Liste Kutusuna ad eklemeden önce, yinelenen adları kaldırmak için toplama nesnesini kullandık.
Yinelenen girişleri kaldırmak için aşağıdaki adımları gerçekleştirdik: -
-
Excel sayfasında tanımlanan aralıktan koleksiyon nesnesine adlar eklendi. Koleksiyon nesnesine yinelenen değerler ekleyemiyoruz. Bu nedenle, Collection nesnesi, yinelenen değerlerle karşılaştığında hata verir. Hataları işlemek için “On Error Resume Next” hata ifadesini kullandık.
-
Koleksiyonu hazırladıktan sonra koleksiyondaki tüm öğeleri diziye ekleyin.
-
Ardından, tüm dizi öğelerini Liste Kutusuna ekleyin.
Lütfen kod için aşağıdan takip edin
Seçenek Explicit Sub Running() UserForm1.Show End Sub 'Kullanıcı formunda aşağıdaki kodu ekleyin Option Explicit Private Sub CommandButton1_Click() Dim var1 As String Dim i As Integer 'Liste kutusunda mevcut tüm değerler arasında döngü 'Seçili değeri değişkene atama var1 For i = 0 ListBox1.ListCount'a - 1 If ListBox1.Selected(i) Sonra var1 = ListBox1.List(i) Exit For End If Next 'Kullanıcı formunu kaldır. Unload Me 'Seçili değeri görüntülüyor MsgBox "Liste Kutusunda aşağıdaki adı seçtiniz: " & var1 End Sub Private Sub UserForm_Initialize() Dim MyUniqueList As Variant, i As Long 'UniqueItemList function çağrılıyor 'Aralığı giriş parametresi olarak atama MyUniqueList = UniqueItemList(Range("A12:A100"), True) With Me.ListBox1 'Liste Kutusu içeriğini temizleme .Clear 'Liste Kutusuna Değerler Ekleme For i = 1 To UBound(MyUniqueList) .AddItem MyUniqueList(i) Sonraki i ' İlk öğenin seçilmesi .ListIndex = 0 End with End Sub Private Function UniqueItemList(InputRange As Range, _ HorizontalList As Boolean) Varyant Olarak Dim cl As Range, cUnique As New Collection, i As Long 'Dinamik bir dizi bildiriyor Dim uList() As Varyant 'Bu işlevi geçici olarak bildirmek' Herhangi bir hücrede hesaplama yapıldığında, işlev yeniden hesaplanacağı anlamına gelir Application.Volatile On Error Resume Next 'Koleksiyona öğe ekleme 'Yalnızca benzersiz öğe eklenecek' Yinelenen öğenin eklenmesi bir hata ile sonuçlanacaktır Her biri için cl InputRange If cl.Value "" Sonra 'cUnique.Add cl.Value, CStr(cl.Value) End If Next koleksiyonuna değerler ekleniyor cl 'Değer başlatılıyor UniqueItemList işlevi tarafından döndürülür = "" cUnique.Count > 0 ise 'Dizi boyutunu yeniden boyutlandırma ReDim uList(1 To cUnique.Count) ' Koleksiyondan diziye değer ekleme For i = 1 To cUnique.Count uList(i) = cUnique(i) Sonraki i UniqueItemList = uList 'YatayList değerini kontrol etme ' Değer true ise, UniqueItemList değerinin transpoze edilmesi HorizontalList Değilse, UniqueItemList = _ Application.WorksheetFunction.Transpose(UniqueItemList) End If End On Error GoTo 0 End Function
Bu blogu beğendiyseniz, Facebook'ta arkadaşlarınızla paylaşın. Ayrıca bizi Twitter ve Facebook'ta da takip edebilirsiniz.
Sizden haber almayı çok isteriz, işimizi nasıl geliştirebileceğimizi ve sizin için nasıl daha iyi hale getirebileceğimizi bize bildirin. E-posta sitesinde bize yazın