在VBA中选择（大）范围内计算不同值的数量？

Question

如何计算VBA中所选（大）范围内的不同值（数字和字符串混合）的数量？

我这样想：
1.将数据读入一维数组。
2.排序阵列（快速或排序合并）需要测试，如果排序阵列
3.只需计数不同值的数目：if(a[i]<>a[i+1]) then counter=counter+1。

它是解决这一问题的最有效方法是什么？

编辑：我想这样做在Excel中。

Answer 1

这里是一个VBA解决方案

你不需要一个数组来完成这件事。你也可以使用一个集合。例如

Sub Samples() 
    Dim scol As New Collection 

    With Sheets("Sheet1") 
     For i = 1 To 100 '<~~ Assuming the range is from A1 to A100 
      On Error Resume Next 
      scol.Add .Range("A" & i).Value, Chr(34) & _ 
      .Range("A" & i).Value & Chr(34) 
      On Error GoTo 0 
     Next i 
    End With 

    Debug.Print scol.Count 

    'For Each itm In scol 
    ' Debug.Print itm 
    'Next 
End Sub 

随访

Sub Samples() 
    Dim scol As New Collection 
    Dim MyAr As Variant 

    With Sheets("Sheet1") 
     '~~> Select your range in a column here 
     MyAr = .Range("A1:A10").Value 

     For i = 1 To UBound(MyAr) 
      On Error Resume Next 
      scol.Add MyAr(i, 1), Chr(34) & _ 
      MyAr(i, 1) & Chr(34) 
      On Error GoTo 0 
     Next i 
    End With 

    Debug.Print scol.Count 

    'For Each itm In scol 
    ' Debug.Print itm 
    'Next 
End Sub 

Answer 2

对不起，这是用C＃编写的。这是我的方式。

// first copy the array so you don't lose any data 
List<value> copiedList = new List<value>(yourArray.ToList()); 

//for through your list so you test every value 
for (int a = 0; a < copiedList.Count; a++) 
{ 
    // copy instances to a new list so you can count the values and do something with them 
    List<value> subList = new List<value>(copiedList.FindAll(v => v == copiedList[i]); 

    // do not do anything if there is only 1 value found 
    if(subList.Count > 1) 
         // You would want to leave 1 'duplicate' in 
    for (int i = 0; i < subList.Count - 1; i++) 
     // remove every instance from the array but one 
     copiedList.Remove(subList[i]); 
} 
int count = copiedList.Count; //this is your actual count 

没有测试过，请尝试。

所以没有与垃圾瞎搞你应该把这个包的方法中。否则，以后只会丢失数组的副本。 （返回计数）

编辑：你需要一个列表这个工作，使用Array.ToList（）;

Answer 3

代替步骤2和3，也许你可以使用一个Scripting.Dictionary每个值添加到字典中。任何重复的条目都会导致运行时错误，您可能会陷入或忽略（resume next）。最后，你可以直接返回字典的count，这会给你唯一条目的数量。

下面是一个代码废料我赶紧扔在一起：

Function UniqueEntryCount(SourceRange As Range) As Long 

    Dim MyDataset As Variant 
    Dim dic As Scripting.Dictionary 
    Set dic = New Scripting.Dictionary 

    MyDataset = SourceRange 

    On Error Resume Next 

    Dim i As Long 

    For i = 1 To UBound(MyDataset, 1) 

     dic.Add MyDataset(i, 1), "" 

    Next i 

    On Error GoTo 0 

    UniqueEntryCount = dic.Count 

    Set dic = Nothing 

End Function 

我知道resume next可以被认为是一个“代码味道”，但替代的方法是用字典的exists功能测试是否指定的键已经存在，然后添加该值，如果没有。我只是有一种感觉，当我在过去做过类似的事情时，忽略重复键引发的任何错误而不是使用exists YMMY会更快。为了完整起见，这里使用exists另一种方法：

Function UniqueEntryCount(SourceRange As Range) As Long 

    Dim MyDataset As Variant 
    Dim dic As Scripting.Dictionary 
    Set dic = New Scripting.Dictionary 

    MyDataset = SourceRange 

    Dim i As Long 

    For i = 1 To UBound(MyDataset, 1) 

     if not dic.Exists(MyDataset(i,1)) then dic.Add MyDataset(i, 1), "" 

    Next i 

    UniqueEntryCount = dic.Count 

    Set dic = Nothing 

End Function 

虽然上面的代码比你提出的方法更简单，这将是值得来测试它的性能对您的解决方案。

Answer 4

大厦由i_saw_drones提出的想法，我强烈建议Scripting.Dictionary。但是，如下所示，这可以在没有On Error Resume Next的情况下完成。另外，他的示例需要链接Microsoft Scripting Runtime库。我的示例将演示如何在不需要进行任何链接的情况下执行此操作。

此外，由于您在Excel中执行此操作，因此您无需在第1步中创建数组。下面的函数将接受一系列单元格，这些单元格将完全迭代。

（即UniqueCount = UniqueEntryCount(ActiveSheet.Cells)或UniqueCount = UniqueEntryCount(MySheet.Range("A1:D100")）

Function UniqueEntryCount(SourceRange As Range) As Long 
    Dim MyDataset As Variant 
    Dim MyRow As Variant 
    Dim MyCell As Variant 
    Dim dic As Object 
    Dim l1 As Long, l2 As Long 

    Set dic = CreateObject("Scripting.Dictionary") 
    MyDataset = SourceRange 

    For l1 = 1 To UBound(MyDataset) 
     ' There is no function to get the UBound of the 2nd dimension 
     ' of an array (that I'm aware of), so use this division to 
     ' get this value. This does not work for >=3 dimensions! 
     For l2 = 1 To SourceRange.Count/UBound(MyDataset) 
      If Not dic.Exists(MyDataset(l1, l2)) Then 
       dic.Add MyDataset(l1, l2), MyDataset(l1, l2) 
      End If 
     Next l2 
    Next l1 

    UniqueEntryCount = dic.Count 
    Set dic = Nothing 
End Function 

它还可能是重要的要注意的是上面的将计数空字符串""作为不同的值。如果你不希望这是这种情况，只需将代码改成这样：

For l1 = 1 To UBound(MyDataset) 
     For l2 = 1 To SourceRange.Count/UBound(MyDataset) 
      If Not dic.Exists(MyDataset(l1, l2)) And MyDataset(l1, l2) <> "" Then 
       dic.Add MyDataset(l1, l2), MyDataset(l1, l2) 
      End If 
     Next l2 
    Next l1