填充列表框与在Excel中使用VBA工作表中唯一值
在本文中，我们将在用户窗体中创建一个列表框，并在删除重复值后将其加载到值中。
我们将在列表框中插入的原始数据由名称组成。此原始数据包含重复的已定义名称。
在此示例中，我们创建了一个由列表框组成的用户窗体。
此列表框将显示示例数据中的唯一名称。要激活用户表单，请单击提交按钮。
该用户表单将返回用户选择的名称，作为在消息框中的输出。
逻辑解释
在列表框中添加名称之前，我们已使用集合对象删除重复的名称。
我们已执行以下步骤来删除重复的条目：-。将Excel工作表中定义范围内的名称添加到集合对象中。在集合对象中，我们不能插入重复的值。因此，Collection对象在遇到重复值时会引发错误。为了处理错误，我们使用了错误声明“ On Error Resume Next”。
。准备好集合后，将集合中的所有项目添加到数组中。
。然后，将所有数组元素插入列表框。
请遵循以下代码
Option Explicit
Sub running()
UserForm1.Show
End Sub
'Add below code in userform
Option Explicit
Private Sub CommandButton1_Click()
Dim var1 As String
Dim i As Integer
'Looping through all the values present in the list box
'Assigning the selected value to variable var1
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
var1 = ListBox1.List(i)
Exit For
End If
Next
'Unload the userform.
Unload Me
'Displaying the selected value
MsgBox "You have selected following name in the List Box : " & var1
End Sub
Private Sub UserForm_Initialize()
Dim MyUniqueList As Variant, i As Long
'Calling UniqueItemList function
'Assigning the range as input parameter
MyUniqueList = UniqueItemList(Range("A12:A100"), True)
With Me.ListBox1
'Clearing the List Box content
.Clear
'Adding values in the List Box
For i = 1 To UBound(MyUniqueList)
.AddItem MyUniqueList(i)
Next i
'Selecting the first item
.ListIndex = 0
End With
End 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 Variant
'Declaring this function as volatile
'Means function will be recalculated whenever calculation occurs in any cell
Application.Volatile
On Error Resume Next
'Adding items to collection
'Only unique item will be inserted
'Inserting duplicate item will through an error
For Each cl In InputRange
If cl.Value <> "" Then
'Adding values in collection
cUnique.Add cl.Value, CStr(cl.Value)
End If
Next cl
'Initializing value return by the function
UniqueItemList = ""
If cUnique.Count > 0 Then
'Resizing the array size
ReDim uList(1 To cUnique.Count)
'Inserting values from collection to array
For i = 1 To cUnique.Count
uList(i) = cUnique(i)
Next i
UniqueItemList = uList
'Checking the value of HorizontalList
'If value is true then transposing value of UniqueItemList
If Not HorizontalList Then
UniqueItemList = _
Application.WorksheetFunction.Transpose(UniqueItemList)
End If
End If
On Error GoTo 0
End Function
如果您喜欢此博客，请在Facebook和Facebook上与您的朋友分享。
我们很希望收到您的来信，请让我们知道我们如何才能改善我们的工作并使您的工作更好。写信给我们[email protected]