Har du set hvor smart det kan være?

SmartOffice - ListComboNoDuplicates

Excel 97: Filling a ListBox With Unique Items When you display a list of items in a ListBox, you generally don't want to show duplicate items. This tip describes a clever way of filling an Excel 97 UserForm with unique items from a list. This technique is adapted from a tip by J.G. Hussey, published in Visual Basic Programmer's Journal. How it works This tip uses a Collection object, and relies on the fact that VBA generates an error if you attempt to add an item to a collection when the item already exists in the collection. The trick is to build the collection by adding all items to it, and ignore the errors that may occur. The result is a collection of unduplicated items. Example I created an example to demonstrate the technique. The items (105 of them) are stored in Column A of a worksheet. Many of these items are duplicated. The RemoveDuplicates subroutine, listed below, builds a collection that consists of the unique items in the list. It then transfers the items to a ListBox on a UserForm.

Eksempel 1

Public Sub ListComboNoDuplicates()
'This example is based on a tip by J.G. Hussey,
'published in "Visual Basic Programmer's Journal"
    Dim rAllCells As Range, rCell As Range
    Dim NoDupes As New Collection
    Dim iCount As Integer, iCounter As Integer
    Dim Swap1, Swap2, Item
    
    'The items are in A1:A105
    Set rAllCells = Range("A1:A105")
    
    'The next statement ignores the error caused
    'by attempting to add a duplicate key to the collection.
    'The duplicate is not added - which is just what we want!
    On Error Resume Next
    For Each rCell In rAllCells
        NoDupes.Add rCell.Value, CStr(rCell.Value)
        'Note: the 2nd argument (key) for the Add method must be a string
    Next rCell

    'Resume normal error handling
    On Error GoTo 0

    'Sort the collection (optional)
    For iCount = 1 To NoDupes.Count - 1
        For iCounter = iCount + 1 To NoDupes.Count
            If NoDupes(iCount) > NoDupes(iCounter) Then
                Swap1 = NoDupes(iCount)
                Swap2 = NoDupes(iCounter)
                NoDupes.Add Swap1, Before:=j
                NoDupes.Add Swap2, Before:=i
                NoDupes.Remove iCount + 1
                NoDupes.Remove iCounter + 1
            End If
        Next iCounter
    Next iCount
    
    'Add the sorted, non-duplicated items to a ListBox
    For Each Item In NoDupes
        ListBox1.AddItem Item
    Next Item
    
    For iCount = 1 To NoDupes.Count
        NoDupes.Remove iCount
    Next iCount
    
    'Close
    Set rAllCells = Nothing
    Set rCell = Nothing
End Sub

Smart Data Management

Compare 2 Columns

Excel Super- Subscript

Teachers Excel Tools