ListBox-kontroller med unike verdier

Eksempelmakroene nedenfor viser hvordan man kan fylle in ListBox-kontroll (og en ComboBox-kontroll) i en UserForm med de unike verdiene fra celler i et regnearkområde. Kopier koden til UserForm-ens kodemodul for å teste den.

Private Sub UserForm_Initialize()
Dim MyUniqueList As Variant, i As Long
    With Me.ListBox1
        .Clear ' clear the listbox content
        MyUniqueList = UniqueItemList(Range("A4:A100"), True)
        For i = 1 To UBound(MyUniqueList)
            .AddItem MyUniqueList(i)
        Next i
        .ListIndex = 0 ' select the first item
    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, uList() As Variant
    Application.Volatile
    On Error Resume Next
    For Each cl In InputRange
        If cl.Formula <> "" Then
            cUnique.Add cl.Value, CStr(cl.Value)
        End If
    Next cl
    UniqueItemList = ""
    If cUnique.Count > 0 Then
        ReDim uList(1 To cUnique.Count)
        For i = 1 To cUnique.Count
            uList(i) = cUnique(i)
        Next i
        UniqueItemList = uList
        If Not HorizontalList Then
            UniqueItemList = _
                Application.WorksheetFunction.Transpose(UniqueItemList)
        End If
    End If
    On Error GoTo 0
End Function

Funksjonen ovenfor kan også benyttes som en matrisefunksjon i et regneark for å returnere de unike verdiene fra et celleområde (utelat 'private' foran funksjonsnavnet).

Dokumentet er sist oppdatert 2000-02-05 22:18:23 Utskriftsvennlig versjon