[英]VBA - Getting unique values from dynamic range
我使用了vba 的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
将从 1 开始。
删除-1
,并记住您正在使用二维数组:
For i = LBound(ClientType, 1) To UBound(ClientType, 1)
UniqueType(ClientType(i, 1)) = 1
Next i
当列表中只有一个单元格时可能的故障模式,因为在这种情况下,您将不会在ClientType
获得二维数组
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.