let
    Источник = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content][Столбец1],
    dupl = Table.FromRecords({[Дубликаты =List.Count(Источник)-List.Count(List.Distinct(Источник))]})
in
    dupl

Sub KolDub()
    c_ = 1
    r0_ = 1
    n_ = Cells(Rows.Count, c_).End(3).Row - r0_ + 1
    ar = Cells(r0_, c_).Resize(n_)
    Set slov1 = CreateObject("Scripting.Dictionary")
    Set slov2 = CreateObject("Scripting.Dictionary")
    With slov1
        For i = 1 To n_
            If .exists(ar(i, 1)) Then
                z_ = z_ + 1
                aaa = slov2.Item(ar(i, 1))
            Else
                aaa = .Item(ar(i, 1))
            End If
        Next i
    End With
    Cells(1, 6) = z_ + slov2.Count
End Sub


Sub KolDub()
    c0_ = 5
    nc_ = Cells(1).SpecialCells(xlLastCell).Column - c0_ + 1
    If nc_ < 1 Then Exit Sub
    r0_ = 1
    nr_ = Cells(1).SpecialCells(xlLastCell).Row - r0_ + 1
    If nr_ < 1 Then Exit Sub
    ar = Cells(r0_, c0_).Resize(nr_, nc_)
    Set slov1 = CreateObject("Scripting.Dictionary")
    Set slov2 = CreateObject("Scripting.Dictionary")
    With slov1
        For i = 1 To nr_
            For j = 1 To nc_
                If Not IsEmpty(ar(i, j)) Then
                    If .exists(ar(i, j)) Then
                        z_ = z_ + 1
                        aaa = slov2.Item(ar(i, j))
                    Else
                        aaa = .Item(ar(i, j))
                    End If
                End If
            Next j
        Next i
    End With
    Cells(1, 2) = z_ + slov2.Count
End Sub

Sub KolDub()
    Dim t!, tt!
    t = Timer
    c0_ = 5
    nc_ = Cells(1).SpecialCells(xlLastCell).Column - c0_ + 1
    If nc_ < 1 Then Exit Sub
    r0_ = 1
    nr_ = Cells(1).SpecialCells(xlLastCell).Row - r0_ + 1
    If nr_ < 1 Then Exit Sub
    ar = Cells(r0_, c0_).Resize(nr_, nc_)
    Set slov1 = CreateObject("Scripting.Dictionary")
    Set slov2 = CreateObject("Scripting.Dictionary")
    tt = Timer
    With slov1
        For j = 1 To nc_
            For i = 1 To nr_
                If Not IsEmpty(ar(i, j)) Then
                    If .exists(ar(i, j)) Then
                        z_ = z_ + 1
                        aaa = slov2.Item(ar(i, j))
                    Else
                        aaa = .Item(ar(i, j))
                    End If
                End If
            Next
            Debug.Print j & "j    " & Format(Timer - tt, "0.00")
            tt = Timer
            DoEvents
        Next

End With
Debug.Print "end    " & Format(Timer - t, "0.00")
Cells(1, 2) = z_ + slov2.Count
End Sub