vba - 在 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 

它也无法将“一个单元格中的多个数字”作为单独的数字处理。

有没有办法制作一个连接 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