Optælling af ens celler

=TÆL.HVIS(A:A;A1)

Træk den nedad, i en kolonne ved siden af, og der vil stå antal ud for hver.

Gælder hvis data står i A kolonnen, ellers ret

Jeg tror det er den her du er ude efter :      =TÆL.HVIS(A:A;B1)
Du har alle dine tal i kolonne A
I kolonne B har du de tal du vil tælle forekomsten af
Indsæt fomlen i kolonne C, og den tæller antallet af hver forekomst

Godt opdateret aheiss !

Det virker fint, men så får jeg det samme nummer vis mange gange f.eks.
Nr.    Antal
123    3
123    3
123    3
759    1
459    2
459    2
Jeg har behov for en oversigt hvor hvert nummer kun vises en gam og så med antal forkomster.

Hvis de er sorteret, kan denne makro bruges.

Den skriver resultatet i de næste 2 kolonner.

Public Sub Tæl_EnsPoster()
I = 0
For Each C In Range(Cells(1, ActiveCell.Column), Cells(65536, ActiveCell.Column).End(xlUp))
If C <> OldC Then
I = I + 1
Cells(I, ActiveCell.Column + 1) = C
Cells(I, ActiveCell.Column + 2).FormulaR1C1 = "=COUNTIF(Ark1!C[-1],RC[-1])"
OldC = C
End If
Next C
End Sub

en rettelse

Public Sub Tæl_EnsPoster()
I = 0
For Each C In Range(Cells(1, ActiveCell.Column), Cells(65536, ActiveCell.Column).End(xlUp))
If C <> OldC Then
I = I + 1
Cells(I, ActiveCell.Column + 1) = C
Cells(I, ActiveCell.Column + 2).FormulaR1C1 = "=COUNTIF(Ark1!C[-2],RC[-2])"
OldC = C
End If
Next C
End Sub

det går godt, udskift denne linie.

Cells(I, ActiveCell.Column + 2).FormulaR1C1 = "=COUNTIF(C[-2],RC[-2])"

Tak Kabbak. Det virker efter hensigten. Smid et svar

DEr var jeg lidt hurtig.
Countif giver forkert resultet

123    3
123    3
123    3
759    1
459    2
459    2
bliver til
Eks. med macro
123    123 3
123    759 3
123    459 3
759
459
459

Så er jeg næsten ved at have den:

Public Sub Tæl_EnsPoster()
k = 0
For Each D In Range(Cells(1, ActiveCell.Column), Cells(65536, ActiveCell.Column).End(xlUp))
    k = k + 1
    Cells(k, ActiveCell.Column + 1) = "=COUNTIF(C[-1],RC[-1])"
Next D
I = 0
For Each C In Range(Cells(1, ActiveCell.Column), Cells(65536, ActiveCell.Column).End(xlUp))
    If C <> OldC Then
        I = I + 1
        Cells(I, ActiveCell.Column + 2) = C
        Cells(I, ActiveCell.Column + 3).FormulaR1C1 = "=IF(RC[-1]>0,VLOOKUP(RC[-1],A:B,2,FALSE))"
        OldC = C
    End If
Next C
End Sub

Alt indhold ser rigtigt ud i excel, men excel vil først accepterer funktionen i sidste kolonne efter et jeg har taste F2 + Enter i cellerne. Det er denne vlookup, der driller. Hvis jeg fjerner vlookup virker funktionen, dog jo ikke som jeg ønsker det. Er der en fidus når der er to funktioner inde i hinanden?

Hvad skal du bruge din vlookup til ?
denne kode klarer optællingen:

Sub ListDuplicates()
Dim AllCells As Range, Cell As Range, X As Long, rgStart As Range
Dim Uniqs As New Collection
    Set rgStart = Application.InputBox("Angiv første celle i resultatområde", , , , , , , 8)
    Set AllCells = Range(Cells(1, ActiveCell.Column), Cells(65536, ActiveCell.Column).End(xlUp))
    On Error Resume Next
    For Each Cell In AllCells
        Uniqs.Add Cell.Value, CStr(Cell.Value)
        If Not Err.Number <> 0 Then
            rgStart.Offset(X, 0) = Cell.Value
            rgStart.Offset(X, 1).Formula = _
                "=COUNTIF(" & AllCells.Address & "," & rgStart.Offset(X, 0).Address & ")"
            X = X + 1
        End If
        Err.Clear
    Next Cell
    Set Uniqs = Nothing
End Sub

Du stiller dig i den kolonne du ønsker optalt og kører makroen. Kolonnen behøver ikke være sorteret.

Vloolup er der kun fordi jeg er novice.
Jeg´har ændret dit script, da jeg ikke ænsker bruger indput. Jeg vil gerne have det til at køre automatisk, hvergang der kommer en fil et en folder. Men det må jeg hellere oprette et nyt spørgsmål på. Excel scriptet ser nu således ud:
Sub ListDuplicates()
Dim AllCells As Range, Cell As Range, X As Long, rgStart As Range
Dim Uniqs As New Collection
    Set rgStart = Cells(1, ActiveCell.Column + 1)
    Set AllCells = Range(Cells(1, ActiveCell.Column), Cells(65536, ActiveCell.Column).End(xlUp))
    On Error Resume Next
    For Each Cell In AllCells
        Uniqs.Add Cell.Value, CStr(Cell.Value)
        If Not Err.Number <> 0 Then
            rgStart.Offset(X, 0) = Cell.Value
            rgStart.Offset(X, 1).Formula = _
                "=COUNTIF(" & AllCells.Address & "," & rgStart.Offset(X, 0).Address & ")"
            X = X + 1
        End If
        Err.Clear
    Next Cell
    Set Uniqs = Nothing
End Sub

bak og kabbak smid svar så forhøjer jeg point og fordeler

ok :-)

ok