【问题标题】:Find all distinct values in user based selection - Excel VBA在基于用户的选择中查找所有不同的值 - Excel VBA
【发布时间】:2014-02-05 20:02:00
【问题描述】:

有没有一种快速简便的方法来使用 VBA 在 Excel 中选择给定选择中的所有不同值?

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

-> 结果应该是 {0,we,1}

提前非常感谢

【问题讨论】:

  • 使用字典优于集合。

标签: vba excel selection distinct


【解决方案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

【讨论】:

  • 代码什么都不做(什么都没有发生),我在哪里可以看到结果?
  • @TomStevens 在运行此之前,您需要选择所有数据,然后在运行后只选择不同的选择。
【解决方案2】:

顺便说一句,我找到了另一个解决方案:

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

【讨论】:

    【解决方案3】:

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

    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

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多