在Excel 2010中，如何在包含多个值单元格的单元格范围内删除重复项并连接值？

Question

I made a document in Excel 2010 however, the functionality I'm hoping to get from it doesn't seem to be possible (at least not with the default Excel functions) and I don't know enough about VB programming to make my own UDF. (I'm actually using one I found online which does part of what I want, but doesn't meet all of my needs.)

Let me break it down:

1. I have multiple sheets with groups of fields where users can add numbers (some will be blank, some will contain a single number, some will contain multiple comma-separated numbers)

2. I have an "Overview" sheet where I want to Concatenate those numbers (and remove any duplicates) within a few different sections (only looking at specific field groups).

I found a ConcatIf UDF that works fairly well for this, however it can't handle non-consecutive cells to concatenate (For example, I want to concatenate and remove duplicates from cells D30, G30, J30 and M30 together) (Here's the UDF:)

Function ConcatIf(ByVal compareRange As Range, ByVal xCriteria As Variant, Optional ByVal stringsRange As Range, _ 
Optional Delimiter As String, Optional NoDuplicates As Boolean) As String 
Dim i As Long, j As Long 
With compareRange.Parent 
    Set compareRange = Application.Intersect(compareRange, Range(.UsedRange, .Range("a1"))) 
End With 
If compareRange Is Nothing Then Exit Function 
If stringsRange Is Nothing Then Set stringsRange = compareRange 
Set stringsRange = compareRange.Offset(stringsRange.Row - compareRange.Row, _ 
stringsRange.Column - compareRange.Column) 

For i = 1 To compareRange.Rows.Count 
    For j = 1 To compareRange.Columns.Count 
        If (Application.CountIf(compareRange.Cells(i, j), xCriteria) = 1) Then 
            If InStr(ConcatIf, Delimiter & CStr(stringsRange.Cells(i, j))) <> 0 Imp Not (NoDuplicates) Then 
                ConcatIf = ConcatIf & Delimiter & CStr(stringsRange.Cells(i, j)) 
            End If 
        End If 
    Next j 
Next i 
ConcatIf = mid(ConcatIf, Len(Delimiter) + 1) 
End Function 

It also can't handle the "multiple numbers in one cell" as separate numbers.

Is there a way to make a Concatenate UDF that "parses" the cells it's looking at to look for duplicates between the multiple numbers cells and the single numbers cells, and then output the result? Preferably allowing it to take a series of non-consecutive cells to work on (across different sheets).

Sorry if the explanation is a bit convoluted, it's my first time asking for this kind of help. :x

Here's an example:

If I have cells with:

• 2,4,6
• 2,6
• 2
• 4
• 6
• 6,8

I'd want to be able to simply get:

• 2,4,6,8

Right now, instead, I'd get:

• 2,4,6,2,6,6,8

Answer 1

Try the below. You can adapt it appropriately if you need to change the delimiter etc. I have documented what it is doing and why.

Example formula: =blah(A1:A7,A8,C9) (it can also be called from code)

Example output: 2,4,6,8

Public Function Blah(ParamArray args()) As String
    'Declarations
    Dim uniqueParts As Collection
    Dim area As Range
    Dim arg, arr, ele, part
    Dim i As Long

    'Initialisations
    Set uniqueParts = New Collection

    'Enumerate through the arguments passed to this function
    For Each arg In args
        If TypeOf arg Is Range Then 'range so we need to enumerate its .Areas
            For Each area In arg.Areas
            arr = area.Value 'for large ranges it is greatly quicker to load the data at once rather than enumerating each cell in turn
                For Each ele In arr 'enumerate the array
                     addParts CStr(ele), uniqueParts 'Call our sub to parse the data
                Next ele
            Next area
        ElseIf VarType(arg) > vbArray Then 'an array has been passed in
            For Each ele In arg 'enumerate the array
                addParts CStr(ele), uniqueParts 'Call our sub to parse the data
            Next ele
        Else 'assume can be validly converted to a string. If it cannot then it will fail fast (as intended)
            addParts CStr(arg), uniqueParts 'Call our sub to parse the data
        End If
    Next arg

    'process our results
    If uniqueParts.Count > 0 Then
        ReDim arr(0 To uniqueParts.Count - 1)
        For i = 1 To uniqueParts.Count
            arr(i - 1) = uniqueParts(i)
        Next i
        'we now have an array of the unique parts, which we glue together using the Join function, and then return it
        Blah = Join(arr, ",")
    End If

End Function
'Sub to parse the data. In this case the sub splits the string and adds the split elements to a collection, ignoring duplicates
Private Sub addParts(partsString As String, ByRef outputC As Collection) 
'ByRef is unecessary but I use it to document that outputC must be instantiated
    Dim part
    For Each part In Split(partsString, ",")
        On Error Resume Next 'existing same key will raise an error, so we skip it and just carry on
        outputC.Add part, part
        On Error GoTo 0
    Next part
End Sub