建议检查范围是否包含VBA中的所有唯一值

时间:2018-09-21 09:49:44

标签: vba excel-vba

说我有这个数据集数组

apple       indonesia   25
apple       malaysia    21
apple       korea       32
orange      japan       27
grape       malaysia    12
strawberry  hongkong    56
durian D24  thailand    22
durian D24  China       72
grape       hongkong    120

我可以选择一个范围。

Dim rng1 as range
dim rng2 as range

set rng1=range(cells(1, 3), cells(9,3))
set rng2=range(cells(1,2),cells(9,2))

所以我们可以看到rng1不包含重复项(所有不重复),但是rng2不包含重复项(不唯一)

我需要做类似的事情

if rng1 is unique=true then

那我想对范围做些什么。

有什么建议吗?

谢谢

4 个答案:

答案 0 :(得分:3)

根据我的评论中的建议,您可以通过以下方式使用dictionary

Function isUnique(rg As Range) As Boolean

Dim dict As Scripting.Dictionary
Dim sngCell As Range

    Set dict = New Dictionary

    For Each sngCell In rg
        If Not dict.Exists(sngCell.Value) Then
            dict.Add sngCell.Value, sngCell.Value
        End If
    Next

    If rg.Cells.Count = dict.Count Then
        isUnique = True
    Else
        isUnique = False
    End If

End Function

以及如何使用功能

Sub Test()
Dim rng1 As Range
Dim rng2 As Range


    Set rng1 = Range(Cells(1, 3), Cells(10, 3))
    Set rng2 = Range(Cells(1, 2), Cells(10, 2))

    If isUnique(rng1) Then
        MsgBox "Is unique"
    Else
        MsgBox "Is not unique"
    End If

End Sub

根据@Jeeped的评论,For loop的{​​{3}}

For Each sngCell In rg
    dict.Item(sngCell.Value) = sngCell.Value
Next
  

通过这种方式为Key分配值具有额外的功能。如果钥匙   不存在,它会自动将Key和Item添加到   字典。如果您有一个排序项目列表,这将很有用   并且只想要每个条目的最后一个条目。

improvement可以为这个问题找到另一个解决方案(示例4)

答案 1 :(得分:0)

对于工作表上的记录号,我使用MODE函数。它返回最常重复的值,如果没有重复的值,则返回#N/A,即所有值都是唯一的:

Function isUnique(rng As Range)
   On Error Resume Next
   Application.WorksheetFunction.Mode (rng)
   isUnique = Err <> 0
   Err.Clear
End Function

答案 2 :(得分:0)

我遍历了范围内的单元格并检查并使用了countif函数: 如果不是WorksheetFunction.Countif(range,range.Cells(i,j).Value)= 1,然后转到中止 效果很好

答案 3 :(得分:0)

如果您可以使用MS 365,则可以使用以下udf:

Function OnlyUniques(rng As Range) As Boolean
'Purp: check if there are only uniques in given range
'Auth: https://stackoverflow.com/users/6460297/t-m
    OnlyUniques = UBound(WorksheetFunction.Unique(rng)) = rng.Rows.Count
End Function