列范围内的唯一值数组

Question

正在尝试找出代码以在一列中创建一个包含所有唯一值的数组。

所以就像 C3:C30 说的那样，我想要一个名为 divisionNames 的数组，其中包含该范围内的所有唯一值。我打算稍后在代码中使用该数组。试图找出一种极简主义的方法，这样我就不会向宏添加 60 多行代码。

非常感谢任何建议

更新：

Gary 的学生下面的回复满足了我的需要，但我非常感谢大家提供的帮助。谢谢你。另外作为旁注，我现在意识到我应该补充说我正在使用 Office 365。老实说，我没有意识到它有那么大的不同，但我会记住这一点以供将来参考，再次感谢大家的帮助

Sub uniq()
    With Application.WorksheetFunction
        divisionNames = .Unique(Range("C3:C30"))
    End With
End Sub

Answer 1

与Excel365:

Sub uniq()
    With Application.WorksheetFunction
        divisionNames = .Unique(Range("C3:C30"))
    End With
End Sub

编辑#1：

此版本将对结果进行排序并将数据放入列 D:

Sub uniq()
    With Application.WorksheetFunction
        divisionNames = .Unique(Range("C3:C30"))
        divisionNames = .Sort(divisionNames)
    End With
    
    u = UBound(divisionNames, 1)
    Range("D3:D" & 3 + u - 1).Value = divisionNames
    
End Sub

Answer 2

唯一（字典）

没有错误处理，即假定范围是 one-column 范围并且没有错误或空值。这可以很容易地实现，但你希望它简短。

1D - 函数

Function getUniqueColumn1D(ColumnRange As Range)
    Dim Data As Variant
    Data = ColumnRange.Resize(, 1).Value
    With CreateObject("Scripting.Dictionary")
        Dim i As Long
        For i = 1 To UBound(Data)
            .Item(Data(i, 1)) = Empty
        Next
        ReDim Data(1 To .Count)
        i = 0
        Dim key As Variant
        For Each key In .Keys
            i = i + 1
            Data(i) = key
        Next key
    End With
    getUniqueColumn1D = Data
End Function

Sub test1D()
    Dim rng As Range
    Set rng = Range("C3:C30")
    Dim Data As Variant
    Data = getUniqueColumn1D(rng)
    Debug.Print Join(Data, vbLf)
End Sub

2D - 函数

Function getUniqueColumn(ColumnRange As Range)
    Dim Data As Variant
    Data = ColumnRange.Resize(, 1).Value
    With CreateObject("Scripting.Dictionary")
        Dim i As Long
        For i = 1 To UBound(Data)
            .Item(Data(i, 1)) = Empty
        Next
        ReDim Data(1 To .Count, 1 To 1)
        i = 0
        Dim key As Variant
        For Each key In .Keys
            i = i + 1
            Data(i, 1) = key
        Next key
    End With
    getUniqueColumn = Data
End Function

Sub TESTgetUniqueColumn()
    Dim rng As Range
    Set rng = Range("C3:C30")
    Dim Data As Variant
    Data = getUniqueColumn(rng)
    ' e.g.
    Dim i As Long
    For i = 1 To UBound(Data)
        Debug.Print Data(i, 1)
    Next i
    ' or:
    Range("A1").Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
End Sub

2D - 子

Sub getUniqueColumnSub()
    Dim Data As Variant
    Data = Range("C3:C30")
    With CreateObject("Scripting.Dictionary")
        Dim i As Long
        For i = 1 To UBound(Data)
            .Item(Data(i, 1)) = Empty
        Next
        ReDim Data(1 To .Count, 1 To 1)
        i = 0
        Dim key As Variant
        For Each key In .Keys
            i = i + 1
            Data(i, 1) = key
        Next key
    End With
    
    ' e.g.
    For i = 1 To UBound(Data)
        Debug.Print Data(i, 1)
    Next i
    ' or:
    Range("A1").Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
End Sub

列范围内的唯一值数组

Array of unique values in a Column range

arrays

excel

vba

unique

唯一（字典）