Question

在Excel中，我有一个从A1到P30的数组，里面有名字。一些单元格具有相同的名称（重复）。有没有一个公式可以在一个列中列出该数组的所有内容（在另一个表上）？此列表必须仅收集唯一名称（不重复）。

提前致谢。

Answer 1

试试这个：

Function Unique(strRng As String) As Variant()

    Dim Arr() As Variant
    ReDim Arr(0)
    Dim rng As Range
    Dim c As Range
    Dim Duplicated As Boolean
    Dim i As Long
    Dim j As Long

    j = 0
    Set rng = Range(strRng)

    For Each c In rng.Cells
        Duplicated = False
        If c.Value <> vbNullString Then
            For i = LBound(Arr) To UBound(Arr)
                If c.Value = Arr(i) Then
                    Duplicated = True
                    Exit For
                End If
            Next i
            If Not Duplicated Then
                ReDim Preserve Arr(j)
                Arr(j) = c.Value
                j = j + 1
            End If
        End If
    Next c

    Unique = Arr

End Function 'Unique

更新

似乎你坚持使用一个功能。简单。创建用户定义函数（UDF），如下所示：

Function Unique(rng As Range) As Variant()

    Dim Arr() As Variant
    ReDim Arr(0)
    Dim c As Range
    Dim Duplicated As Boolean
    Dim i As Long
    Dim j As Long

    j = 0

    For Each c In rng.Cells
        Duplicated = False
        If c.Value <> vbNullString Then
            For i = LBound(Arr) To UBound(Arr)
                If c.Value = Arr(i) Then
                    Duplicated = True
                    Exit For
                End If
            Next i
            If Not Duplicated Then
                ReDim Preserve Arr(j)
                Arr(j) = c.Value
                j = j + 1
            End If
        End If
    Next c

    Unique = Arr
    ' OR
    'Unique = Application.Transpose(Arr) 'Use this when you want transpose your range from row to column or back.


End Function 'Unique

如何使用该功能？

请注意，这是array form函数。

在VBA中编写第二个代码。
选择要返回唯一值的范围。（在每个工作表和列的每个部分）
在公式栏中写下=Unique(A1:P30)，然后按键盘上的 Ctrl + Shift + Enter 。（不要只按 Enter ）

现在，您有一个公式可以返回您所说的范围的唯一值。

Answer 2

我更喜欢使用Collection或Dictionary来检查重复项。

在这个例子中，我使用了一个ArrayList

Sub ProcessNames()
    Dim v As Variant
    Dim list As Object
    Set list = CreateObject("System.Collections.ArrayList")

    With Worksheets("Sheet1")
    For Each v In .Range("A1:P30").Value
        If Not list.Contains(v) Then list.Add v
    End With

    '1 Dimensional 0 Based Array which will span 1 Row
    v = list.ToArray

    '2 Dimensional 1 Based Array that will span 1 Column
    v = WorksheetFunction.Transpose(v)
End Sub

Excel列出一行中的数组（不重复）

2 个答案:

更新