JOS sama luku, lisää 1

vanhoja yhdistäen ;-)

moduuliin...

Sub lajittele()
Dim solu As Range
Dim vika As Long
Dim i As Long
Dim EiTupla As New Collection
Dim Löydetty As Range

On Error GoTo virhe
Vika = Range("E65536").End(xlUp).Row
For Each solu In Range("E1:E" & Vika)
If Not IsEmpty(solu) Then
EiTupla.Add solu.Value, CStr(solu.Value)
End If
Next solu
Range("F:G") = ""
Range("F1").Select
For i = 1 To EiTupla.Count
ActiveCell = EiTupla(i)
ActiveCell.Offset(1, 0).Select
Next
Columns("F:F").Sort Key1:=Range("F1"), Order1:=xlAscending
Vika = Range("F65536").End(xlUp).Row
For Each solu In Range("F1:F" & Vika)
Set Löydetty = EtsiJaSiirrä(solu)
solu.Offset(0, 1) = Löydetty.Cells.Count
Next
Exit Sub
virhe:
Resume Next
End Sub


Function EtsiJaSiirrä(Hakuehto As Variant) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Sheet1").Activate
With Range("E:E")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function

Keep Excelling
@Kunde

Kunde esittää erinomaisia VBA-pätkiä (kiitos niiitä!), mutta minusta tämä olisi Pivot taulukolla ratkaistava ongelma. Mikäli oikein käsitin, olisi vain saatava tietää eri vuosilukujen lukumäärät ja ne saa helpoimmin Pivotilla.
Jos pelkillä kaavoilla mennään, siin silloin jokaiselle vuosiluvulle olisi varattava oma solu, johon =LASKE.JOS(E:E);1980) tyyppinen kaava.