Option
Explicit
Sub
Unik_Lista_Antal()
'© 2003
Alla rättigheter XL-Dennis
Dim
wbBook
As
Workbook
Dim
wsSheet
As
Worksheet, wsTarget
As
Worksheet
Dim
rnFilter
As
Range, rnTarget
As
Range
Dim
vaUnique
As
Variant
Dim
i
As
Long
Set
wbBook = ThisWorkbook
Set
wsSheet = wbBook.Worksheets("Blad1")
With
wsSheet
Set
rnFilter = .Range(.Range("A1"),
.Range("A65536").End(xlUp))
End
With
'Lägger
till ett nytt arbetsblad.
Set
wsTarget = wbBook.Worksheets.Add
'Skapar
en unik lista och kopierar den till den nya arbetsbladet.
rnFilter.AdvancedFilter xlFilterCopy, , Range("A1"),
True
With
wsTarget
Set
rnTarget = .Range(.Range("A1"),
.Range("A65536").End(xlUp))
End
With
vaUnique = rnTarget.Value
'Räknar
antal förekomster per värde.
For
i =
1
To
UBound(vaUnique)
rnTarget(i,
1).Offset(0,
1).Value
= _
Application.Evaluate("COUNTIF("
&
rnFilter.Address(external:=True)
&
_
","""
&
rnTarget(i,
1).Text
&
""")")
Next
i
'Ta
bort antal förekomster för det första värdet som utgör namnet på listan.
rnTarget(1,
1).Offset(0,
1).Clear
End
Sub