Find data, og lav tabel med disse

Prøv med denne makro:

Sub Filtrer()
Dim r, k, rk As Integer
For k = 2 To 5
rk = 10
For r = 10 To 5000
If WorksheetFunction.CountIf(Range(Cells(10, k + 5), Cells(5000, k + 5)), Cells(r, k)) = 0 Then
Cells(rk, k + 5) = Cells(r, k)
rk = rk + 1
End If
Next
Next
End Sub

Her er forskellige forslag til at undersøge en enkelt kolonne for ens data. Det kan måske give lidt inspiration?

http://superuser.com/questions/49614/how-do-i-get-the-distinct-unique-values-in-a-column-in-excel

Kan foretages uden VBA ved nedenstående formel:

=HVIS.FEJL(MINDSTE(HVIS(FREKVENS(B$10:B$5000;B$10:B$5000)>0;B$10:B$5000);RÆKKER($1:1));"") i celle G10. Kopier ned til række 5000 og ud til kolonne J.

Jens48, Petersen7913 og Sdh

Tak for jeres indlæg.

Jeg vil nu prøve jeres forslag, og informerer om resultatet.

Hej Jens48.

Det virker som ønsket.
Jeg skal nu blot sortere på de enkelte kolonner, for at få en opstilling i kronologisk orden på hver kolonne.

Kan du eventuelt skrive en makro, der er lige så forståelig som dit forslag. Jeg har testet med makrooptageren, men synes ikke det ser enkelt ud.

Prøv med denne makro. Jeg har også sat en ClearContents linie ind i starten.

Sub Filtrer()
Dim r, k, rk As Integer
Range("G10:J5000").ClearContents
For k = 2 To 5
rk = 10
For r = 10 To 5000
If WorksheetFunction.CountIf(Range(Cells(10, k + 5), Cells(5000, k + 5)), Cells(r, k)) = 0 Then
Cells(rk, k + 5) = Cells(r, k)
rk = rk + 1
End If
Next
Range(Cells(10, k + 5), Cells(5000, k + 5)).Select
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range(Cells(10, k + 5), Cells(5000, k + 5)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range(Cells(10, k + 5), Cells(5000, k + 5))
        .Header = False
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Next
Cells(1, 1).Select
End Sub

Hej Jens48

Det virker. Mange tak. Men første gang jeg eksekverede makroen. Fandt den kun kontonumrene uden at sortere. jeg prøvede så igen, og vupti virkede det.