=ЕСЛИ(ЕОШИБКА(ЕСЛИ(ВПР(ПРАВСИМВ(A2;ДЛСТР(A2)-НАЙТИ("@";A2;НАЙТИ("@";A2)));B:B;1;0)=ПРАВСИМВ(A2;ДЛСТР(A2)-НАЙТИ("@";A2;НАЙТИ("@";A2)));"";A2))=ИСТИНА;A2;"")

Function СцепитьЕсли(ByRef Диапазон As Range, ByVal Критерий As String, ByRef Диапазон_сцепления As Range, Optional Разделитель As String = " ", Optional БезПовторов As Boolean = False) As String
    Dim li As Long, sStr As String, avItem, avDateArr(), avRezArr(), lUBnd As Long
    If Диапазон.Count > 1 Then
        avDateArr = Intersect(Диапазон, Диапазон.Parent.UsedRange).Value
        avRezArr = Intersect(Диапазон_сцепления, Диапазон_сцепления.Parent.UsedRange).Value
        If Диапазон.Rows.Count = 1 Then
            avDateArr = Application.Transpose(avDateArr)
            avRezArr = Application.Transpose(avRezArr)
        End If
    Else
        ReDim avDateArr(1, 1): ReDim avRezArr(1, 1)
        avDateArr(1, 1) = Диапазон.Value
        avRezArr(1, 1) = Диапазон_сцепления.Value
    End If
    lUBnd = UBound(avDateArr, 1)
    'Определяем вхождение операторов сравнения в Критерий
    Dim objRegExp As Object, objMatches As Object
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = False: objRegExp.Pattern = "=|<>|=>|>=|<=|=<|>|<"
    Set objMatches = objRegExp.Execute(Критерий)
    'Если есть вхождения
    If objMatches.Count > 0 Then
        Dim sStrMatch As String
        sStrMatch = objMatches.Item(0)
        Критерий = Replace(Replace(Критерий, sStrMatch, "", 1, 1), Chr(34), "", 1, 2)
        Select Case sStrMatch
        Case "="
            For li = 1 To lUBnd
                If avDateArr(li, 1) = Критерий Then
                    If Trim(avRezArr(li, 1)) <> "" Then _
                       sStr = sStr & IIf(sStr <> "", Разделитель, "") & avRezArr(li, 1)
                End If
            Next li
        Case "<>"
            For li = 1 To lUBnd
                If avDateArr(li, 1) <> Критерий Then
                    If Trim(avRezArr(li, 1)) <> "" Then _
                       sStr = sStr & IIf(sStr <> "", Разделитель, "") & avRezArr(li, 1)
                End If
            Next li
        Case ">=", "=>"
            For li = 1 To lUBnd
                If avDateArr(li, 1) >= Критерий Then
                    If Trim(avRezArr(li, 1)) <> "" Then _
                       sStr = sStr & IIf(sStr <> "", Разделитель, "") & avRezArr(li, 1)
                End If
            Next li
        Case "<=", "=<"
            For li = 1 To lUBnd
                If avDateArr(li, 1) <= Критерий Then
                    If Trim(avRezArr(li, 1)) <> "" Then _
                       sStr = sStr & IIf(sStr <> "", Разделитель, "") & avRezArr(li, 1)
                End If
            Next li
        Case ">"
            For li = 1 To lUBnd
                If avDateArr(li, 1) > Критерий Then
                    If Trim(avRezArr(li, 1)) <> "" Then _
                       sStr = sStr & IIf(sStr <> "", Разделитель, "") & avRezArr(li, 1)
                End If
            Next li
        Case "<"
            For li = 1 To lUBnd
                If avDateArr(li, 1) < Критерий Then
                    If Trim(avRezArr(li, 1)) <> "" Then _
                       sStr = sStr & IIf(sStr <> "", Разделитель, "") & avRezArr(li, 1)
                End If
            Next li
        End Select
    Else    'Если нет вхождения
        For li = 1 To lUBnd
            If avDateArr(li, 1) Like Критерий Then
                If Trim(avRezArr(li, 1)) <> "" Then _
                   sStr = sStr & IIf(sStr <> "", Разделитель, "") & avRezArr(li, 1)
            End If
        Next li
    End If
    
    If БезПовторов Then
        Dim oDict As Object, sTmpStr
        Set oDict = CreateObject("Scripting.Dictionary")
        sTmpStr = Split(sStr, Разделитель)
        On Error Resume Next
        For li = LBound(sTmpStr) To UBound(sTmpStr)
            oDict.Add sTmpStr(li), sTmpStr(li)
        Next li
        sStr = ""
        sTmpStr = oDict.keys
        For li = LBound(sTmpStr) To UBound(sTmpStr)
            sStr = sStr & IIf(sStr <> "", Разделитель, "") & sTmpStr(li)
        Next li
    End If
    СцепитьЕсли = sStr
End Function

=СцепитьЕсли(C$2:C$1048576;"<>0";C$2:C$1048576;", ";1)

=ЕСЛИ(СЧЁТЕСЛИ(A:A;"*"&ПРАВСИМВ(A2;ДЛСТР(A2)-НАЙТИ("@";A2;НАЙТИ("@";A2)))&"*")-1>0;"Есть домен";"Нет домена")

Option Explicit
Option Base 1

Public Function TextSimilarity(text1 As Variant, text2 As Variant) As Double
' Метрика сходства текстовых строк (0-1)
Dim i As Integer, k As Integer, m As Integer
Dim profile() As Integer
Dim dupVect() As String * 2
Dim txt As String
Dim txtNum As Integer

    ReDim profile(2, Len(text1) + Len(text2) - 2 + 4)
    ReDim dupVect(Len(text1) + Len(text2) - 2 + 4)
    m = 0
    
    txt = " " & text1 & " "
    For txtNum = 1 To 2
        For i = Len(txt) - 1 To 1 Step -1
            For k = 1 To m
                If StrComp(dupVect(k), Mid(txt, i, 2), 1) = 0 Then Exit For '>>>
            Next k
            If k > m Then 'Not found
                m = k 'm + 1
                dupVect(k) = Mid(txt, i, 2)
            End If
            If profile(txtNum, k) = 0 Then
                profile(txtNum, k) = 1
                'profile(txtNum, k) = 2
                'Различия в количестве одинаковых последовательностей
                'в 2 раза менее значимы, чем в их наличии/отсутствии.
            Else
                profile(txtNum, k) = profile(txtNum, k) + 1
            End If
        Next i
    txt = " " & text2 & " "
    Next txtNum
    
Dim sumMax As Integer, sumDif As Integer
    For k = 1 To m
        sumDif = sumDif + Abs(profile(1, k) - profile(2, k))
        If profile(1, k) < profile(2, k) Then
            sumMax = sumMax + profile(2, k)
        Else
            sumMax = sumMax + profile(1, k)
        End If
    Next k
    TextSimilarity = 1 - sumDif / sumMax
    
End Function