При добавлении уникальных значений массива в диапазон Excel выделите ячейку, если она является дубликатом.

У меня есть массив значений result, которые я получил из вызова REST API — result = [1,2,3,4,5], и они анализируются как варианты в функции AppendUnique.

Что я хочу сделать:

Функция AppendUnique добавляет уникальные значения из растущего массива result в диапазон в Excel. Я хочу добавить новую функцию в AppendUnique, где повторяющиеся значения в массиве result будут выделены в ячейке Excel.

Объяснение моего текущего кода:

В начале

Я ввожу каждое значение в массив result, чтобы заполнить ячейки от A1 до A5 (диапазон динамический, основанный на количестве значений в массиве, поэтому может не быть A5 все время).

Итак, если диапазон (A1-A100) пуст, мы заполняем ячейки как обычно.

^ эта часть завершена

По мере роста массива результатов

Поскольку результат будет увеличиваться при повторном запуске макроса, например, через 15 минут result может стать [1,2,3,4,5,6,7,8]

Итак, если диапазон (A1-A5) не пуст, мы добавляем дополнительные элементы массива в конец диапазона ячеек, если они не отображаются в диапазоне (то есть они являются дополнительными)

^ эта часть завершена

Результат также может содержать дубликаты, например, через 30 минут result может стать [1,2,3,4,5,6,7,8,3], где 3 — дубликат.

Если есть дубликат - 3, ячейка A3 (где мы заполнили 3) должна быть выделена.

^ этот вопрос об этой части

Мой текущий код:

Sub AppendUnique( _
        Arr() As Variant, _
        ByVal ws As Worksheet, _
        ByVal FirstCellAddress As String, _
        Optional ByVal OverWrite As Boolean = False)
   
    ' Write the data from the source range to the source array ('sData').
    ' Reference the first destination cell ('fCell').

    If ws.FilterMode Then ws.ShowAllData
    
    Dim fCell As Range: Set fCell = ws.Range(FirstCellAddress)
    
    Dim sData() As Variant, srCount As Long
    
    With fCell
        Dim lCell As Range: Set lCell = .Resize(ws.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If Not lCell Is Nothing Then
            srCount = lCell.Row - .Row + 1
            If srCount = 1 Then
                ReDim sData(1 To 1, 1 To 1): sData(1, 1) = .Value
            Else
                sData = .Resize(srCount).Value
            End If
            If Not OverWrite Then Set fCell = lCell.Offset(1)
        End If
    End With
            
    ' Write the unique data from the source array to a dictionary.
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim sr As Long
    
    For sr = 1 To srCount: dict(CStr(sData(sr, 1))) = Empty: Next sr
    
    Erase sData
    
    ' Define the destination array ('dData').
    
    Dim lb As Long: lb = LBound(Arr)
    Dim ub As Long: ub = UBound(Arr)
    
    Dim dData() As Variant: ReDim dData(1 To ub - lb + 1, 1 To 1)
                 
    ' Check the values from the given array ('Arr') against the values
    ' in the dictionary and write the non-matches to the destination array.
    
    Dim dr As Long, c As Long, cString As String
                 
    For c = lb To ub
        cString = CStr(Arr(c))
        If Len(cString) > 0 Then ' is not blank
            If Not dict.Exists(cString) Then ' is not in the dictionary
                dict(cString) = Empty ' prevent dupes from the given array
                dr = dr + 1
                dData(dr, 1) = cString
            End If
        End If
    Next c
    
    If dr = 0 Then
        MsgBox "No new values found.", vbExclamation
        Exit Sub
    End If
    
    ' Write the values from the destination array to the destination range.
    
    fCell.Resize(dr).Value = dData
    If OverWrite Then ' clear below
        fCell.Resize(ws.Rows.Count - fCell.Row - dr + 1).Offset(dr).Clear
    End If
        
    ' Inform.
        
    MsgBox "Data appended.", vbInformation
         
End Sub

Сначала я подумал, может быть, я могу сделать что-то под линией — If Len(cString) > 0 Then, чтобы добавить If dict. Exists(cstring) Then, выделить ячейку, выполнив что-то вроде interior.color = vbYellow.

Однако я понял, что в моем текущем коде продукты добавляются полностью после проверки повторяющихся элементов, поэтому я не совсем уверен, как выделить ячейку с повторяющимся значением, поскольку мы не зацикливаемся на добавленном диапазоне.

Любая помощь будет принята с благодарностью, заранее спасибо.