Выделите дублирующее значение в строке на основе запятой

Question

Если у меня есть значения в ячейке c3 = 2,4,6,8,12,14,18,23,35,78,101,38,30,205,2,101 В этих двух значениях дубликаты, что {2,101} Я хочу уведомления и когда я введу любое значение дважды, трижды, четвертый раз и т. д. c в этой ячейке, я должен узнать, какое значение повторяется. Дублирующие значения могут отображаться в соседней ячейке D3,

Answer 1

Попробуйте это

Sub Test_CheckDups_UDF()
With Range("A1")
    .Value = "2,4,6,8,12,14,18,23,35,78,101,38,30,205,2,101"
    .Offset(, 1).Value = CheckDups(.Value)
End With
End Sub

Function CheckDups(s As String) As String
Dim a, dic As Object, i As Long

Set dic = CreateObject("scripting.dictionary")
a = Split(s, ",")

For i = LBound(a) To UBound(a)
    If dic.Exists(a(i)) = True Then CheckDups = CheckDups & IIf(CheckDups = Empty, "", ",") & a(i) Else dic.Add a(i), 1
Next i
End Function

Вот код, который выделит дубликаты в одной и той же ячейке. Настройте его так, чтобы он соответствовал вашим потребностям

Sub Highlight_Duplicates_Within_Cell()
Dim s, sp, k, c As Range, t As String, f As Boolean, n As Long

For Each c In Range("C3:C13")
    c.Font.Color = vbBlack

    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        sp = Split(c.Value, ",")
        For Each s In sp
            If Not .Exists(s) Then .Add s, 1 Else .Item(s) = .Item(s) + 1
        Next s

        For Each k In .Keys
            t = "," & k & ","
            f = False
            n = InStr(1, "," & c.Value & ",", t, vbTextCompare)
            Do While n And .Item(k) > 1
                If f Then
                    c.Characters(n, Len(t) - 2).Font.Color = vbRed
                End If
                n = InStr(n + Len(k), "," & c.Value & ",", t, vbTextCompare)
                f = True
            Loop
        Next k
    End With
Next c
End Sub

Попробуйте эту версию тоже, используя Regex

Sub Highlight_Duplicates2()
Dim mtch As Object, mtch2 As Object, m As Object, mm As Object, c As Range, txt As String, i As Long

For Each c In Range("C3:C13")
    With CreateObject("VBScript.RegExp")
        .Global = True
        txt = c.Value
        .Pattern = " *(\w+)"
        Set mtch = .Execute(txt)

        For Each m In mtch
            .Pattern = "\b" & m.submatches(0) & "\b"
            Set mtch2 = .Execute(txt)

            If mtch2.Count > 1 Then
                For i = 1 To .Execute(txt).Count - 1
                    Set mm = mtch2(i)
                    With c.Characters(mm.firstindex + 1, mm.length).Font
                        .Color = vbRed: .Bold = True
                    End With
                    Mid$(txt, mm.firstindex + 1, mm.length) = Space(mm.length)
                Next i
            End If
        Next m
    End With
Next c
End Sub

Answer 2

Это не соответствует вашему запросу перехвата дубликатов при наборе текста. Однако для обработки строки, разделенной запятыми ( после ввода ), рассмотрите следующую пользовательскую функцию:

Public Function duplist(s As String) As String
    Dim s2 As String, arr
    Dim kount As Long, i As Long, j As Long
    arr = Split(s, ",")

    For i = 0 To UBound(arr)
        kount = 0
        v = arr(i)
        For j = 0 To i
            If v = arr(j) Then kount = kount + 1
        Next j
        If kount = 2 Then s2 = s2 & "," & v
    Next i
    duplist = Mid(s2, 2)
End Function