Microsoft Excel에서 VBA를 사용하여 워크 시트의 고유 한 값으로 목록 상자 채우기
이 기사에서는 사용자 양식에 목록 상자를 만들고 중복 값을 제거한 후 값을로드합니다.
목록 상자에 삽입 할 원시 데이터는 이름으로 구성됩니다. 이 원시 데이터는 정의 된 이름에 이중성을 포함합니다.
이 예에서는 List Box로 구성된 사용자 양식을 만들었습니다.
이 목록 상자에는 샘플 데이터의 고유 한 이름이 표시됩니다. 사용자 양식을 활성화하려면 제출 버튼을 클릭하십시오.
이 사용자 양식은 사용자가 선택한 이름을 메시지 상자의 출력으로 반환합니다.
논리 설명
목록 상자에 이름을 추가하기 전에 컬렉션 개체를 사용하여 중복 된 이름을 제거했습니다.
중복 항목을 제거하기 위해 다음 단계를 수행했습니다. 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]로 문의 해주세요