在Excel 2010中，如何在包含多個值單元格的單元格范圍內刪除重復項並連接值？

Question

我在Excel 2010中創建了一個文檔但是，我希望從中獲取的功能似乎不可能（至少沒有使用默認的Excel函數）而且我對VB編程的了解不夠UDF。 （我實際上使用的是我在網上找到的一部分，它可以滿足我的所有需求，但不能滿足我的所有需求。）

讓我分解一下：

1. 我有多個字段組，其中用戶可以添加數字（一些將為空，一些將包含一個數字，一些將包含多個以逗號分隔的數字）

2. 我有一個“概述”表，我想在幾個不同的部分（僅查看特定的字段組）中連接這些數字（並刪除任何重復）。

我找到了一個相當好的ConcatIf UDF，但它不能處理連續的非連續單元格（例如，我想連接並刪除單元格D30，G30，J30和M30中的重復項）（這里是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 

它也不能將“一個單元格中的多個數字”作為單獨的數字處理。

有沒有辦法讓Concatenate UDF“解析”它正在查看的單元格，以查找多個數字單元格和單個數字單元格之間的重復，然后輸出結果？ 優選地允許它采取一系列非連續的單元來處理（跨越不同的紙張）。

對不起，如果解釋有點復雜，這是我第一次要求這種幫助。 ：X

這是一個例子：

如果我有細胞：

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

我希望能夠簡單地得到：

• 2,4,6,8

現在，相反，我會得到：

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

Answer 1

試試下面的內容。 如果您需要更改分隔符等，您可以適當地調整它。我已經記錄了它正在做什么以及為什么。

示例公式： =blah(A1:A7,A8,C9) （也可以從代碼中調用）

輸出示例： 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