Điền vào một Hộp danh sách với các giá trị duy nhất từ một trang tính bằng VBA trong Microsoft Excel
Trong bài viết này, chúng tôi sẽ tạo Hộp danh sách ở dạng người dùng và tải nó với các giá trị sau khi loại bỏ các giá trị trùng lặp.
Dữ liệu thô mà chúng tôi sẽ chèn vào Hộp danh sách, bao gồm tên. Dữ liệu thô này chứa sự trùng lặp trong các tên đã xác định.
Trong ví dụ này, chúng tôi đã tạo một biểu mẫu người dùng bao gồm Hộp danh sách.
Hộp Danh sách này sẽ hiển thị các tên duy nhất từ dữ liệu mẫu. Để kích hoạt biểu mẫu người dùng, hãy nhấp vào nút gửi.
Biểu mẫu người dùng này sẽ trả về tên được người dùng chọn làm đầu ra trong hộp thông báo.
Giải thích logic
Trước khi thêm tên vào Hộp danh sách, chúng tôi đã sử dụng đối tượng bộ sưu tập để loại bỏ các tên trùng lặp.
Chúng tôi đã thực hiện các bước sau để xóa các mục nhập trùng lặp: -. Đã thêm tên từ phạm vi đã xác định trong trang tính Excel vào đối tượng tập hợp. Trong đối tượng bộ sưu tập, chúng tôi không thể chèn các giá trị trùng lặp. Vì vậy, đối tượng Collection gây ra lỗi khi gặp các giá trị trùng lặp. Để xử lý lỗi, chúng tôi đã sử dụng câu lệnh báo lỗi “On Error Resume Next”.
-
Sau khi chuẩn bị bộ sưu tập, hãy thêm tất cả các mục từ bộ sưu tập vào mảng.
-
Sau đó, chèn tất cả các phần tử mảng vào Hộp Danh sách.
Vui lòng theo dõi bên dưới để biết mã
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
Nếu bạn thích blog này, hãy chia sẻ nó với bạn bè của bạn trên Facebook và Facebook.
Chúng tôi rất muốn nghe ý kiến từ bạn, hãy cho chúng tôi biết cách chúng tôi có thể cải thiện công việc của mình và làm cho nó tốt hơn cho bạn. Viết thư cho chúng tôi [email protected]