функция отображения уникальных ячеек

Question

Функция VBA, которая удаляет дубликаты и записывает их через запятую

Мне нужна формула (функция), которая будет иметь два аргумента: 1. диапазон (будет выбран) 2. символ-разделитель между дубликатами. Пример У меня в диапазоне есть несколько кодов продуктов 0001, 0015, 0015, 0015, 0015, 0015, 0015, 0015, 0015, 0020 в разных ячейках. Я хочу получить 0001, 0015, 0020 по формуле.

То, что я написал:

Function UNIQUE_NUMBER(RangeD As Range, SepCharacter As String)
Dim UNIQUE As String
On Error GoTo msg
For Each cell In RangeD
If Not IsEmpty(cell) Then
    If Cells(cell.Row, cell.Column) = "" Then Resume Next
    r = cell.Row
    C = cell.Column
    a_length = Len(a)
    a = a & SepCharacter & Cells(r, C)


        If WorksheetFunction.Search(Cells(r, C) & SepCharacter, a, a_length + 1) > 1 And Cells(r, C) <> "" Then
        a = WorksheetFunction.Substitute(a, Cells(r, C) & SepCharacter, "", 1)

        End If
End If

Next cell
SepCharacter2 = SepCharacter & SepCharacter
UNIQUE = Mid(a, Len(SepCharacter) + 1, Len(a))
UNIQUE_NUMBER = Replace(Replace(Replace(Replace(Replace(Replace(Replace(UNIQUE, SepCharacter2, ""), SepCharacter2, ""), SepCharacter2, ""), SepCharacter2, ""), SepCharacter2, ""), SepCharacter2, ""), SepCharacter2, "")
Exit Function
msg:
Resume Next
End Function

И иногда это работает правильно (как-то), а иногда нет. Что вы предлагаете ?

Answer 1

проблема решена

Function UNIQUE_WELDER(RangeD As Range, sepChar As String)

'we will gather all unique values into VAL1
VAL1 = ""
For Each cell In RangeD

'if value is added into VAL1 we will not add again
'and using replace function for deleting spaces
qty = InStr(VAL1, Replace(Replace(Replace(Replace(Replace(Replace(cell, " ", ""), " ", ""), " ", ""), " ", ""), " ", ""), " ", ""))
If qty > 0 Then VAL1 = VAL1 Else VAL1 = Replace(VAL1 & sepChar & cell, sepChar & sepChar, sepChar)
Next cell
'deleting first symbol
VAL2 = Mid(VAL1, Len(sepChar) + 1, 1000)
UNIQUE_WELDER = VAL2
End Function

Answer 2

Если я вас правильно понимаю,

• ваши коды продуктов находятся в диапазоне ячеек, с одним кодом на ячейку
• ваш результат должен быть в одной ячейке, как sepChar отдельная ячейка.
  • Поскольку вы показываете свой результат с comma-space в качестве разделителя, я использую его в качестве разделителя по умолчанию в коде.

Если у вас есть Excel O365 , вы можете сделать это с помощью формулы рабочего листа:

=TEXTJOIN(", ",TRUE,UNIQUE(myRange))

Если нет, то, вероятно, проще всего использовать процедуру VBA:

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

В приведенном ниже коде я демонстрирую объект Collection, поскольку он также присутствует в Excel для MA C.

Option Explicit
Function vbaUNIQUE(rg As Range, Optional sep As String = ", ") As String
    Dim col As Collection
    Dim c As Range
    Dim i As Long, s As String

Set col = New Collection

'Collection object will return an error if we try
' to add a duplicate key.  Therefore the `OnError`
' statement will skip over any duplicates
On Error Resume Next
For Each c In rg
    If Not c.Value = "" Then col.Add Item:=c.Value, Key:=CStr(c.Value)
Next c
On Error GoTo 0

'create output string
For i = 1 To col.Count
    s = s & sep & col(i)
Next i

vbaUNIQUE = Mid(s, Len(sep) + 1)

End Function