【发布时间】:2014-02-05 20:02:00
【问题描述】:
有没有一种快速简便的方法来使用 VBA 在 Excel 中选择给定选择中的所有不同值?
0 | we | 0
--+----+--
we| 0 | 1
-> 结果应该是 {0,we,1}
提前非常感谢
【问题讨论】:
-
使用字典优于集合。
标签: vba excel selection distinct
有没有一种快速简便的方法来使用 VBA 在 Excel 中选择给定选择中的所有不同值?
0 | we | 0
--+----+--
we| 0 | 1
-> 结果应该是 {0,we,1}
提前非常感谢
【问题讨论】:
标签: vba excel selection distinct
试试这个:
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
【讨论】:
顺便说一句,我找到了另一个解决方案:
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
【讨论】:
另一种方法是创建一个用户函数。以下函数将返回一个包含所有不同值的行数组。
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
代码利用了您只能向集合添加不同值的事实。否则会返回错误。
通过在至少足够大以包含不同值的范围上使用此函数,它将列出输入范围中的不同值。使用应返回矩阵的函数时,请记住使用 Ctrl+Shift+Enter。
【讨论】: