Попълнете поле със списък с уникални стойности от работен лист, използвайки VBA в Microsoft Excel

Anonim

В тази статия ще създадем List Box в userform и ще го заредим със стойности, след като премахнем дублиращите се стойности.

Суровите данни, които ще вмъкнем в списъка, се състоят от имена. Тези необработени данни съдържат дублиране в определени имена.

В този пример създадохме потребителска форма, която се състои от List Box. Това списъчно поле ще показва уникални имена от примерните данни. За да активирате потребителската форма, кликнете върху бутона за изпращане.

Тази потребителска форма ще върне избраното от потребителя име като изход в поле за съобщение.

Логично обяснение

Преди да добавим имена в списъчното поле, използвахме обект за събиране, за да премахнем дублиращи се имена.

Изпълнихме следните стъпки за премахване на дублиращи се записи:-

  1. Добавени имена от определения диапазон в листа на Excel към обект за събиране. В обект за събиране не можем да вмъкнем дублирани стойности. Така че обектът за събиране хвърля грешка при среща с дублирани стойности. За да се справим с грешките, използвахме изявление за грешка „Следващо възобновяване на грешката“.

  2. След като подготвите колекцията, добавете всички елементи от колекцията към масива.

  3. След това вмъкнете всички елементи на масива в списъчното поле.

Моля, следвайте кода по -долу

 Опция Explicit Sub running () UserForm1.Show End Sub 'Добавете кода по -долу в userform Опция Explicit Private Sub CommandButton1_Click () Dim var1 As String Dim i As Integer' Циклично преминаване през всички стойности, присъстващи в списъчното поле 'Присвояване на избраната стойност на променлива var1 За i = 0 Към ListBox1.ListCount - 1 Ако ListBox1.Selected (i) Тогава var1 = ListBox1.List (i) Изход за край, ако следващ 'Разтоварете потребителската форма. Unload Me 'Показване на избраната стойност MsgBox "Вие сте избрали следното име в полето със списъци:" & var1 End Sub Private Sub UserForm_Initialize () Dim MyUniqueList Като вариант, i As Long' Calling UniqueItemList function 'Присвояване на диапазона като входен параметър MyUniqueList = UniqueItemList (Range ("A12: A100"), True) С Me.ListBox1 'Изчистване на съдържанието на списъчното поле .Clear' Добавяне на стойности в списъчното поле за i = 1 към UBound (MyUniqueList) .AddItem MyUniqueList (i) Следващ i ' Избор на първия елемент .ListIndex = 0 Завършване с End Sub Частна функция UniqueItemList (InputRange As Range, _ HorizontalList As Boolean) As Variant Dim cl As Range, cUnique As New Collection, i As Long 'Обявяване на динамичен масив Dim uList () като Вариант „Обявяване на тази функция като променлива“ Функцията означава, че ще се преизчислява всеки път, когато се случи изчисление в която и да е клетка Приложение. Нестабилно при грешка Възобновяване Напред „Добавяне на елементи към колекция“ Ще бъде вмъкнат само уникален елемент „Вмъкването на дублиращ се елемент ще доведе до грешка За всеки cl In InputRange If cl.Value "" Тогава 'Добавяне на стойности в колекция cUnique.Add cl.Value, CStr (cl.Value) End If Next cl' Инициализиране на стойността се връща от функцията UniqueItemList = "" Ако cUnique.Count> 0 Тогава "Промяна на размера на масива ReDim uList (1 To cUnique.Count)" Вмъкване на стойности от колекция в масив For i = 1 To cUnique.Count uList (i) = cUnique (i) Next i UniqueItemList = uList "Проверка на стойността на HorizontalList" Ако стойността е вярна, тогава транспонирането на стойността на UniqueItemList Ако не е HorizontalList Тогава UniqueItemList = _ Application.WorksheetFunction.Transpose (UniqueItemList) End If End Ако е включено Грешка GoTo 0 End Функция 

Ако този блог ви е харесал, споделете го с приятелите си във Facebook. Също така можете да ни следвате в Twitter и Facebook.

Ще се радваме да чуем от вас, уведомете ни как можем да подобрим работата си и да я направим по -добра за вас. Пишете ни на имейл сайта