删除VBA数组中的重复项

代码正常工作。 基于回应帮助修改。

我有以下代码从数组，MyArray中删除重复项。 该代码得到一个debugging错误： 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 

Answer 1

你应该学会停止依靠Selection （这毕竟是为什么你已经宣布你的variables…）。 你可以改为MyArray = Range1.Value 。

现在，范围数组总是将是二维的，而不是那个，如果你select一个列范围，你将会非常需要这样做：

MyArray = Application.Transpose(Range1.Value)

或者，如果您正在select一个行范围：

MyArray = Application.Transpose(Application.Transpose(Range1.Value)

如果是多维范围，您可能需要进行其他操作。 我没有testing过。

这里有一些想法：

 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 

Answer 2

像这样的东西（给你一个单一的行或给你使用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