VBA - 从动态范围中获取唯一值答案

【问题标题】：VBA - Getting unique values from dynamic rangeVBA - 从动态范围中获取唯一值
【发布时间】：2020-06-13 22:46:58
【问题描述】：

我使用来自 vba: get unique values from array 的 eksortso 的答案从数组中获取唯一值

Sub Trial()
    Dim myArray() As Variant
    Dim i As Long
    Dim d As Object

    myArray() = Array("Banana", "Apple", "Orange", "Tomato", "Apple", "Lemon", "Lime", "Lime", "Apple")

    Set d = CreateObject("Scripting.Dictionary")

    For i = LBound(myArray) To UBound(myArray)
        d(myArray(i)) = 1
    Next i

End Sub

这很有效，但是当我尝试将其应用于从工作表中读取的范围时，它给了我一个错误 - Run-time error '9': Subscript out of range

Sub Clients()

    Dim Sht As Worksheet
    Dim LastRow As Long
    Dim StartCell As Range
    Dim ClientType As Variant
    Dim UniqueType As Object
    Dim i As Long

    Set Sht = Worksheets("ALL CLIENTS")
    Set StartCell = Range("F6")

    'Find Last Row
    LastRow = Sht.Cells(Sht.Rows.Count, StartCell.Column).End(xlUp).Row

    'Read Client Type Column
    ClientType = Sht.Range(StartCell, Sht.Cells(LastRow, StartCell.Column))

    Set UniqueType = CreateObject("Scripting.Dictionary")

    For i = (LBound(ClientType) - 1) To UBound(ClientType)
        UniqueType(ClientType(i)) = 1
    Next i

End Sub

这是因为myArray 开始于下标0 而ClientType 开始于1？我该如何解决这个问题？

【问题讨论】：

问题出在ClientType = Sht.Range(StartCell, Sht.Cells(LastRow, StartCell.Column))。您的 StartCell 单元格来自 active 表，但 Sht - 来自 ALL CLIENTS 表。如果ALL CLIENTS 工作表不是活动工作表，那么您就有问题了。
@JohnyL 感谢您指出这一点

标签： excel vba

【解决方案1】：

是的，ClientType 将从 1 开始。

删除-1，并记住您正在使用二维数组：

For i = LBound(ClientType, 1) To UBound(ClientType, 1)
    UniqueType(ClientType(i, 1)) = 1
Next i

当列表中只有一个单元格时可能出现故障模式，因为在这种情况下您将不会在ClientType 中获得二维数组

【讨论】：

我可以问一个后续问题吗？一些单元格是“#N/A”，显示为Error 2042。如何获得文本“#N/A”。这个想法是将其填充到复选框用户表单中。当我使用ClientType = Sht.Range(StartCell, Sht.Cells(LastRow, StartCell.Column)) 时，它会在我运行UniqueType(ClientType(i, 1)) = 1 时显示Run-time error '13': Type mismatch。无论如何让字典阅读.Text而不是.Value？

【解决方案2】：

Sub UniqueVal2Range()
    Dim Arr As New Collection, a
    Dim Item As Variant
    Dim vRng As Range

    Lr = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row    'Range Last Row
    Set vRng = Sheet1.Range("A2:A" & Lr)

    If vRng.Count > 0 Then
    '---Making Unique Values
        On Error Resume Next
            For Each a In vRng
               Arr.Add a, a
            Next
        On Error GoTo 0

    '---Printing Unique Values
        For Each Item In Arr
            Debug.Print Item
        Next Item
    End If
End Sub

【讨论】：