Arrays 列范围中唯一值的数组

试图找出代码，以在一列中生成所有唯一值的数组

比如说C3:C30，我想要一个名为divisionNames的数组，它包含该范围内所有唯一的值。我打算稍后在代码中使用数组。试图找出一种最简单的方法，这样我就不会在宏中再添加60行代码了

如有任何建议，我将不胜感激

更新：

加里的学生在下面的回答确实满足了我的需要，但我非常感谢大家给予的帮助。非常感谢。另外，我现在意识到，我应该补充一点，我正在使用Office 365。老实说，我没有意识到这有多大的不同，但我会记住这一点，以供将来参考，并再次感谢所有的帮助

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

---

使用Excel 365

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

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

编辑#1:

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

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

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

唯一（字典）

• 没有错误处理，即假定范围为一列范围，并且没有错误或空值。这可能很容易实现，但您希望它简短

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

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-功能

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

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

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

---

我还有最后一个问题，非常感谢你的帮助

使用代码

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

---

如何添加错误处理，例如，如果我得到一个下标超出范围的错误（或者实际上是任何其他错误），我可以抛出一个msgbox，说“您选择了错误的文件”

这里有一种使用字典的方法：您需要什么样的数组？基于1D 0、1D 1还是基于2D 1？基于2D的1可以轻松粘贴到列范围中：

范围（“A1”）。调整大小（Ubound（数据，1），Ubound（数据，2））。值=数据

。不需要转置。老实说，我只是需要一个…我想是名字的列表，这样我以后可以把它们放进一个组合框中。加里的学生在下面的回答对我起了作用。谢谢你们花时间回复，真的很感谢。老实说，我非常感谢这些论坛上所有令人惊叹的人。既然你对短代码感兴趣，这里有一个。这就可以了，谢谢你，我现在唯一需要弄清楚的是，我是否可以按部门名称的字母顺序对数据进行排序，但这只是一个简单的问题nicety@GeekyMeeks见我的编辑，谢谢你的回复。我希望不要花太长的时间（如果不是更长的话，我会花一个小时）我非常感谢你花时间回复。加里学生的回答起了作用，而且很好，很简短。我只是想说谢谢你花时间打字out@GeekyMeeks：别担心，我是为可能没有365的用户编写的。但是谢谢你的反馈。3行对15行：这是一个不需要动脑筋的问题。