=СЧЁТЕСЛИ(A:A;A2)>1

Option Explicit'Автор Б. Виталий В. (bedvit)
'Макрос записан: 21/10/2016
'Редакция: 6 от 26/02/2020
'Действие: выделение разными цветами дубликатов в выделенных диапазонах
Sub select_replica() 'рабочий
Dim R As Range, Rf As Range, Rc As Range, i As Long, s(3) As Long, ac, t, x, cell
Dim Dict: Set Dict = CreateObject("Scripting.Dictionary")
Dim DictColor: Set DictColor = CreateObject("Scripting.Dictionary")
t = Timer
 
On Error Resume Next
If Selection.CountLarge = 1 Then
    Set Rf = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas, 23)
    Set Rc = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants, 23)
Else
    Set Rf = Intersect(ActiveSheet.UsedRange, Selection).SpecialCells(xlCellTypeFormulas, 23)
    Set Rc = Intersect(ActiveSheet.UsedRange, Selection).SpecialCells(xlCellTypeConstants, 23)
End If
On Error GoTo 0
 
With Application: .ScreenUpdating = 0: .DisplayAlerts = 0: .EnableEvents = 0: ac = .Calculation: .Calculation = -4135: .StatusBar = "BE: обработка данных...": End With
Set R = Rf: GoSub Go_
Set R = Rc: GoSub Go_
With Application: .ScreenUpdating = 1: .DisplayAlerts = 1: .EnableEvents = 1: .Calculation = ac: .StatusBar = False: End With
Debug.Print "select_replica = " & Timer - t
MsgBox "Выделено разных групп дубликатов (разными цветами): " & i, vbInformation
Exit Sub
     
Go_:
If Not R Is Nothing Then
    R.Interior.Pattern = Empty
    For Each cell In R.Cells
        If Dict.Exists(cell.Value) Then
            x = Dict.Item(cell.Value)
            If x(3) = 1 Then
                i = i + 1
                x(2) = 6740479
            cell.Interior.Color = x(2)
        Else
            s(0) = cell.Row
            s(1) = cell.Column
            s(3) = 1
            Dict.Add cell.Value, s
        End If
    Next
End If
Return
End Sub
 
Function Generate_nice_color() As Long
Dim R As Long, G As Long, B As Long
Do
    Randomize
    R = Int(Rnd * 256)
    G = Int(Rnd * 256)
    B = Int(Rnd * 256)
Loop Until R + G + B > 500 And R + G + B < 700
Generate_nice_color = RGB(R, G, B)
End Function

=ЕСЛИМН(ДЛСТР(M2)>0;K2<=M2;ДЛСТР(O2)>0;K2<=O2;ДЛСТР(Q2)>0;K2<=Q2;ДЛСТР(S2)>0;K2<=S2;ДЛСТР(U2)>0;K2<=U2;ДЛСТР(W2)>0;K2<=W2;ДЛСТР(Y2)>0;K2<=Y2;ДЛСТР(AA2)>0;K2<=AA2;ДЛСТР(AC2)>0;K2<=AC2;ДЛСТР(AE2)>0;K2<=AE2;ДЛСТР(AG2)>0;K2<=AG2;ДЛСТР(AI2)>0;K2<=AI2;ДЛСТР(AK2)>0;K2<=AK2;ДЛСТР(AM2)>0;K2<=AM2;ДЛСТР(AO2)>0;K2<=AO2;ДЛСТР(AQ2)>0;K2<=AQ2;ДЛСТР(AS2)>0;K2<=AS2)

 =ЕСЛИ(ИЛИ(ДЛСТР(M2)>0;ДЛСТР(O2)>0;ДЛСТР(Q2)>0;ДЛСТР(S2)>0;ДЛСТР(U2)>0;ДЛСТР(W2)>0;ДЛСТР(Y2)>0;ДЛСТР(AA2)>0;ДЛСТР(AC2)>0;ДЛСТР(AE2)>0;ДЛСТР(AG2)>0;ДЛСТР(AI2)>0;ДЛСТР(AK2)>0;ДЛСТР(AM2)>0;ДЛСТР(AO2)>0;ДЛСТР(AQ2)>0;ДЛСТР(AS2)>0);И(K2<=M2;K2<=O2;K2<=Q2;K2<=S2;K2<=U2;K2<=W2;K2<=Y2;K2<=AA2;K2<=AC2;K2<=AE2;K2<=AG2;K2<=AI2;K2<=AK2;K2<=AM2;K2<=AO2;K2<=AQ2;K2<=AS2))

=ЕСЛИ($B$2<>1;"Аларм";"")

Sub Find_Matches()
  Dim a, b, d, r&, tm
  tm = Timer
  a = Range([m2], Cells(Rows.Count, 13).End(xlUp))
  Set d = CreateObject("Scripting.Dictionary")
  For r = 1 To UBound(a): d(a(r, 1)) = 1: Next
  a = Selection: ReDim b(1 To UBound(a), 1 To 1)
  For r = 1 To UBound(a)
    If d.exists(a(r, 1)) Then b(r, 1) = "ok"
  Next
  Selection.Offset(0, 1) = b
  MsgBox Timer - tm
End Sub

Sub Test()
    Dim arrNoNCD, arrData, arrOut, LastRow As Long, iRow As Long, i As Long, iCol As Long
       
    With ActiveSheet
        If .FilterMode Then .ShowAllData
        LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
        arrNoNCD = .Range("G2:G" & LastRow).Value
        LastRow = .Cells(.Rows.Count, "AD").End(xlUp).Row
        arrData = .Range("AD2:AY" & LastRow).Value
    End With
       
    ReDim arrOut(1 To UBound(arrNoNCD), 1 To UBound(arrData, 2))
    For iRow = 1 To UBound(arrNoNCD)
        For i = 1 To UBound(arrData)
            If arrData(i, 1) = arrNoNCD(iRow, 1) Then
                For iCol = 1 To UBound(arrData, 2)
                    arrOut(iRow, iCol) = arrData(i, iCol)
                Next iCol
            End If
        Next i
    Next iRow
       
    Range("BA2").Resize(UBound(arrOut, 1), UBound(arrOut, 2)).Value = arrOut
    MsgBox "Данные выведены в столбец BA", vbInformation, "Конец"
End Sub

=ПРОСМОТР(2^15;ПОИСК(F$2:F$4;A2);G$2:G$4)

=ЕСЛИМН(И(K4<M4;M4=" <>");"";И(K4<O4;O4<>" ");"";И(K4<Q4;Q4<>" ");"";И(K4<S4;S4<>" ");"";И(K4<U4;U4<>" ");"";И(K4<W4;W4<>" ");"";И(K4<Y4;Y4<>" ");"";И(K4<AA4;AA4<>" ");"";И(K4<AC4;AC4<>" ");"";И(K4<AE4;AE4<>" ");"")

=ЕСЛИМН(M4<>" ";K4<M4;O4<>" ";K4<O4;Q4<>" ";K4<Q4;S4<>" ";K4<S4;U4<>" ";K4<U4;W4<>" ";K4<W4;Y4<>" ";K4<Y4;AA4<>" ";K4<AA4;AC4<>" ";K4<AC4;AE4<>" ";K4<AE4)

=СЦЕП($A2;"\";$B2;"\";C2;"\";$AA2;"\";$AB2;"\";$AC2)

Sub Listduplicates()
'Updateby Extendoffice 20160613
    Dim rngA As Range
    Set rngA = Range([E1], Cells(Rows.Count, "E").End(xlUp))
    rngA.Offset(0, 1).Columns.Insert
    With rngA.Offset(0, 1)
        .FormulaR1C1 = _
        "=IF(ISNA(MATCH(RC[-1],C[1],0)),"""",INDEX(C[1],MATCH(RC[-1],C[1],0)))"
        .Value = .Value
    End With
End Sub

Sub Find_Matches()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim CompareRange As Variant, x As Variant, y As Variant
' Установка переменной CompareRangeравной сравниваемому диапазону
Set CompareRange = Range("M2:M100")
' Если сравниваемый диапазон находится на другом листе или книге,
' используйте следующий синтаксис
' Set CompareRange = Workbooks("Книга2"). _
'   Worksheets("Лист2").Range("B1:B11")
'
' Сравнение каждого элемента в выделенном диапазоне с каждым элементом
' переменной CompareRange
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 2) = x
Next y
Next x
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub