在基于用户的select中find所有不同的值 – Excel VBA

有没有一种快速和简单的方法来selectExcel中给定的select与VBA中的所有不同的值？

0 | we | 0 --+----+-- we| 0 | 1 

– >结果应该是{0，我们，1}

提前谢谢了

Answer 1

试试这个：

 Sub Distinct() Dim c As Collection Set c = New Collection Dim r As Range Dim dis As Range Set dis = Nothing For Each r In Selection If r.Value <> "" Then On Error Resume Next c.Add r.Value, CStr(r.Value) If Err.Number = 0 Then If dis Is Nothing Then Set dis = r Else Set dis = Union(dis, r) End If End If Err.Number = 0 On Error GoTo 0 End If Next r dis.Select End Sub 

Answer 2

顺便说一下，我find了另一个解决scheme：

 Option Explicit Public Sub Test() Dim cell As Object Dim d As Object Set d = CreateObject("Scripting.Dictionary") For Each cell In Selection d(cell.Value) = 1 Next cell MsgBox d.count & " unique item(s) in selection (" & Join(d.Keys, ",") & ")" End Sub 

Answer 3

另一种方法是创build一个用户函数。 下面的函数将返回一个包含select中所有不同值的行数组。

 Function ReturnDistinct(InpRng) Dim Cell As Range Dim i As Integer Dim DistCol As New Collection Dim DistArr() If TypeName(InpRng) <> "Range" Then Exit Function 'Add all distinct values to collection For Each Cell In InpRng On Error Resume Next DistCol.Add Cell.Value, CStr(Cell.Value) On Error GoTo 0 Next Cell 'Write collection to array ReDim DistArr(1 To DistCol.Count) For i = 1 To DistCol.Count Step 1 DistArr(i) = DistCol.Item(i) Next i ReturnDistinct = DistArr End Function 

代码利用了这样一个事实，即只能将不同的值添加到集合中。 否则，它将返回一个错误。

通过在至less足够大以包含不同值的范围上使用此函数，它将列出input范围中的不同值。 请记住，在处理应返回matrix的函数时，请使用Ctrl + Shift + Enter 。