删除 VBA 数组中的重复项
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/23481700/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Deleting duplicates in a VBA Array
提问by user2242044
CODE WORKS CORRECTLY. MODIFIED BASED ON HELP FROM RESPONSES.
代码正常工作。根据响应的帮助进行修改。
I have the following code to remove duplicates from a array, MyArray. The code gets a debugging error at: d(MyArray(i)) = 1. The error is subscript out of range. Not sure what is causing this and what is wrong with my code.
我有以下代码从数组 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
采纳答案by David Zemens
You should learn to stop relying on Selection(this is after all why you have declared your variables...). You can do MyArray = Range1.Valueinstead.
你应该学会停止依赖Selection（这毕竟是你声明变量的原因......）。你可以这样做MyArray = Range1.Value。
Now, a Range Array is always going to be 2-dimensional, you instead of that, you will acutally need to do this if you are selecting a COLUMN range:
现在，范围数组始终是二维的，如果您选择 COLUMN 范围，您将需要这样做：
MyArray = Application.Transpose(Range1.Value)
MyArray = Application.Transpose(Range1.Value)
Or this, if you are selecting a ROW range:
或者，如果您选择 ROW 范围：
MyArray = Application.Transpose(Application.Transpose(Range1.Value)
MyArray = Application.Transpose(Application.Transpose(Range1.Value)
You may need to do other operations if it is multi-dimensional range. I haven't tested.
如果是多维范围，您可能需要进行其他操作。我没有测试。
Here are some ideas:
这里有一些想法：
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
回答by brettdj
Something like this (for a single column or single row given you use Transpose)
像这样的东西（对于给定的单列或单行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
