|
Option
Explicit
Sub
Tilldela_Combobox_Arbetsblad_Unika_Poster()
'© 2004 Alla rättigheter XL-Dennis
Dim
wbBook
As
Workbook
Dim
wsSheet
As
Worksheet
Dim
rnData
As
Range
Dim
vaData
As Variant
Dim
i
As Long
Set
wbBook = ThisWorkbook
With
wbBook
Set
wsSheet = .Worksheets("Blad1")
End With
With
wsSheet
'Cell
A1 måste innehålla ett kolumnnamn för att Avancerat Filter
'ska kunna användas.
Set
rnData = .Range(.Range("A1"),
.Range("A65536").End(xlUp))
'Skapar
listan med unika poster.
rnData.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("L1"),
Unique:=True
'Läser
in listan till en variant matris.
vaData = .Range(.Range("L2"),
.Range("L65536").End(xlUp)).Value
'Ta
bort listan från arbetsbladet.
.Range(.Range("L1"),
.Range("L65536").End(xlUp)).ClearContents
End With
With
wsSheet.OLEObjects("Combobox1").Object
.Clear
.List = vaData
'Tilldela comboboxen listan med unika poster.
.ListIndex
= -1
End With
End Sub
|