如何从Excel VBA中的范围获取唯一值列表？
我想要使用VBA得到一个范围内的唯一值列表。 Google中的大多数例子都是使用VBA获取列中唯一值的列表。
我不知道如何改变它来获得一个范围内的价值清单。
例如，
Currency Name 1 Name 2 Name 3 Name 4 Name 5 SGD BGN DBS PHP PDSS KRW BGN CNY CBBT BGN IDA INPC 我的数组应该看起来像：
BGN, DBS, PDSS, CBBT and INPC.
我该怎么做？ 需要一些指导。
我会使用一个简单的VBA-Collection并添加项与键。 关键是项目本身，因为不能有重复键集合将包含唯一的值。
注意：因为向收集添加了复制键引发了错误，所以将收集添加到错误恢复下一个。
函数GetUniqueValues具有source-range-values作为参数，并且回退VBA-Collection 唯一源范围值 。 在main方法中调用该函数并将结果打印到输出窗口中。 HTH。
示例源代码范围如下所示：
Option Explicit Sub main() Dim uniques As Collection Dim source As Range Set source = ActiveSheet.Range("A2:F6") Set uniques = GetUniqueValues(source.Value) Dim it For Each it In uniques Debug.Print it Next End Sub Public Function GetUniqueValues(ByVal values As Variant) As Collection Dim result As Collection Dim cellValue As Variant Dim cellValueTrimmed As String Set result = New Collection Set GetUniqueValues = result On Error Resume Next For Each cellValue In values cellValueTrimmed = Trim(cellValue) If cellValueTrimmed = "" Then GoTo NextValue result.Add cellValueTrimmed, cellValueTrimmed NextValue: Next cellValue On Error GoTo 0 End Function
产量
SGD PHP KRW CNY IDA BGN PDSS CBBT INPC DBS a
如果源范围由区域组成，则首先获取所有区域的值。
Public Function GetSourceValues(ByVal sourceRange As Range) As Collection Dim vals As VBA.Collection Dim area As Range Dim val As Variant Set vals = New VBA.Collection For Each area In sourceRange.Areas For Each val In area.Value If val <> "" Then _ vals.Add val Next val Next area Set GetSourceValues = vals End Function
源types现在是集合，但所有的作品都是一样的：
Dim uniques As Collection Dim source As Collection Set source = GetSourceValues(ActiveSheet.Range("A2:F6").SpecialCells(xlCellTypeVisible)) Set uniques = GetUniqueValues(source)
循环遍历范围，检查值是否在数组中，如果没有添加到数组中。
Sub test() Dim Values() As Variant Values = GetUniqueVals(Selection) Dim i As Integer For i = LBound(Values) To UBound(Values) Debug.Print (Values(i)) Next End Sub Function GetUniqueVals(ByRef Data As Range) As Variant() Dim cell As Range Dim uniqueValues() As Variant ReDim uniqueValues(0) For Each cell In Data If Not IsEmpty(cell) Then If Not InArray(uniqueValues, cell.Value) Then If IsEmpty(uniqueValues(LBound(uniqueValues))) Then uniqueValues(LBound(uniqueValues)) = cell.Value Else ReDim Preserve uniqueValues(UBound(uniqueValues) + 1) uniqueValues(UBound(uniqueValues)) = cell.Value End If End If End If Next GetUniqueVals = uniqueValues End Function Function InArray(ByRef SearchWithin() As Variant, ByVal SearchFor As Variant) As Boolean Dim i As Integer Dim matched As Boolean 'Default value of boolean is false, we make true only if we find a match For i = LBound(SearchWithin) To UBound(SearchWithin) If SearchWithin(i) = SearchFor Then matched = True Next InArray = matched End Function