代码工作正确。基于响应的帮助进行修改。
我有以下代码从数组MyArray中删除重复项。代码在d(MyArray(i)) = 1
处收到调试错误。错误是下标超出范围。不确定是什么导致了这个以及我的代码出了什么问题。
Sub DataStats1()
Dim Range1 As Range
Dim MyArray As Variant
Set Range1 = Application.InputBox("Select Range1:", Title:="Set Data Range", Type:=8)
Range1.Select
MyArray = Application.Transpose(Application.Transpose(Range1.Value))
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
For Each el In MyArray
d(el) = 1
Next
Dim v As Variant
v = d.Keys()
For i = 1 To UBound(v)
MsgBox v(i)
Next i
End Sub
答案 0 :(得分:2)
你应该学会停止依赖Selection
(这毕竟是你宣布变量的原因......)。您可以改为MyArray = Range1.Value
。
现在,一个范围数组总是二维的,如果你选择一个COLUMN范围,你将需要这样做:
MyArray = Application.Transpose(Range1.Value)
或者,如果您选择ROW范围:
MyArray = Application.Transpose(Application.Transpose(Range1.Value)
如果是多维范围,您可能需要执行其他操作。我没有经过测试。
以下是一些想法:
Sub DataStats1()
Dim Range1 As Range
Dim MyArray As Variant
Dim v As Variant
Dim d As Object
Set Range1 = Application.InputBox("Select Range1:", Title:="Set Data Range", Type:=8)
MyArray = Application.Transpose(Application.Transpose(Range1.Value))
Set d = CreateObject("Scripting.Dictionary")
For Each el In MyArray
d(el) = 1
Next
'## Assign the Keys to an array:
v = d.Keys
'## At this point, v is an array of unique values.
' Do whatever you want with it:
'
'Print the list to a COLUMN new sheet:
Sheets.Add
Range("A1").Resize(UBound(v) + 1).Value = Application.Transpose(v)
'Or print the list to a msgBox:
MsgBox Join(v, ", ")
'Or print to the console:
Debug.Print Join(v, ", ")
End Sub
答案 1 :(得分:1)
这样的事情(对于使用Transpose
的单列或单行)
Sub DataStats1()
Dim Rng1 As Range
Dim MyArray As Variant
Dim MyArray2 As Variant
Dim el
Dim d As Object
On Error Resume Next
Set Rng1 = Application.InputBox("Select Range1:", Title:="Set Data Range", Type:=8)
On Error GoTo 0
If Rng1 Is Nothing Then Exit Sub
MyArray = Application.Transpose(Application.Transpose(Rng1.Value))
Set d = CreateObject("Scripting.Dictionary")
For Each el In MyArray
If Not d.exists(el) Then d.Add el, 1
Next
MyArray2 = d.items
End Sub